http://fhz4linux.info/tiki-forums_rss.php?ver=2 Mon, 06 Sep 2010 16:28:09 +0100 Tiki CMS/Groupware via FeedCreator 1.7.2 http://fhz4linux.info//img/tiki.jpg http://fhz4linux.info//tiki-index.php en-us http://fhz4linux.info//tiki-view_forum_thread.php?forumId=1&comments_parentId=0 Sokol Mon, 24 Nov 2008 13:39:47 +0100 http://fhz4linux.info//tiki-view_forum_thread.php?forumId=1&comments_parentId=0 alexirion Sun, 24 Aug 2008 11:59:47 +0100 http://fhz4linux.info//tiki-view_forum_thread.php?forumId=1&comments_parentId=0 81 0c 04 __ 09 09 a0 01 HH HH 00 00 _6 xx // Istwert Stellantrieb taucht aber nie in meinen Log Ausgaben auf. Überhaupt kommt nie ein Telegram das nach dem Hauscode eine 00 hat. Ich verwende die FHZ1000PC und habe 2 FHT80b. Wer kann die Stellantrieb Ist Werte empfangen bzw. hat vielleicht ähnliche Probleme. --Alex]]> alexirion Wed, 20 Aug 2008 20:01:49 +0100 http://fhz4linux.info//tiki-view_forum_thread.php?forumId=1&comments_parentId=0 david_ffm Sun, 25 Nov 2007 15:40:12 +0100 http://fhz4linux.info//tiki-view_forum_thread.php?forumId=1&comments_parentId=0 MBeuker Mon, 12 Mar 2007 22:28:46 +0100 http://fhz4linux.info//tiki-view_forum_thread.php?forumId=1&comments_parentId=0 klaus01 Wed, 07 Mar 2007 23:34:45 +0100 http://fhz4linux.info//tiki-view_forum_thread.php?forumId=1&comments_parentId=0 maschke Sun, 04 Mar 2007 16:42:03 +0100 http://fhz4linux.info//tiki-view_forum_thread.php?forumId=1&comments_parentId=0 jmanbln Tue, 04 Jul 2006 09:18:07 +0100 http://fhz4linux.info//tiki-view_forum_thread.php?forumId=1&comments_parentId=0 Error Call FHZWrite("C9", "02011f60") ' --> Guten Tach If Not FHZRead(sTT$, sData$) Then ' --> FHZRead failed 'Ansonsten Ergebnis in TT$ & sData$ Call FHZWrite("04", "c90184570208") If Not FHZRead(sTT$, sData$) ' --> Error ' FS20 Init Call FHZWrite("04", "c90196") ' Gerät 1112 mit Hauscode 1234-1234 einschalten Call FHZWrite("04", "020101" + Hauscode$("1234", "1234") + Addr$("1112") + "11") FHZClose Un hier die Routinen : Public Function FHZOpen() As Boolean Dim lngNumDevices As Long Dim strSerialNumber As String * 256 Dim strDescription As String * 256 Dim ftStatus As Long FHZOpen = False If FT_GetNumDevices(lngNumDevices, vbNullString, FT_LIST_BY_NUMBER_ONLY) <> FT_OK Then Exit Function End If If FT_ListDevices(0, strDescription, FT_LIST_BY_INDEX Or FT_OPEN_BY_DESCRIPTION) <> FT_OK Then Exit Function End If If FT_ListDevices(0, strSerialNumber, FT_LIST_BY_INDEX Or FT_OPEN_BY_SERIAL_NUMBER) <> FT_OK Then Exit Function End If ' Open the device If FT_OpenEx(strDescription, FT_OPEN_BY_DESCRIPTION, lngHandle) <> FT_OK Then Exit Function End If ' Set baud rate to 9600 If FT_SetBaudRate(lngHandle, 9600) <> FT_OK Then If FT_Close(lngHandle) <> FT_OK Then 'Error End If Exit Function End If ' 8 data bits, 1 stop bit, no parity If FT_SetDataCharacteristics(lngHandle, FT_BITS_8, FT_STOP_BITS_1, FT_PARITY_NONE) <> FT_OK Then 'Error If FT_Close(lngHandle) <> FT_OK Then 'List1.AddItem "Close Failed" End If Exit Function End If ' no flow control If FT_SetFlowControl(lngHandle, FT_FLOW_NONE, 0, 0) <> FT_OK Then 'Error If FT_Close(lngHandle) <> FT_OK Then 'List1.AddItem "Close Failed" End If Exit Function End If ' 5 second read timeout If FT_SetTimeouts(lngHandle, 5000, 0) <> FT_OK Then 'Error If FT_Close(lngHandle) <> FT_OK Then 'Error End If Exit Function End If If FT_SetChars(lngHandle, 126, 1, 0, 0) <> FT_OK Then 'Error If FT_Close(lngHandle) <> FT_OK Then 'Error End If Exit Function End If Call FT_Purge(lngHandle, FT_PURGE_RX Or FT_PURGE_TX) Call FT_ResetDevice(lngHandle) FHZOpen = True End Function Public Sub FHZClose() If FT_Close(lngHandle) <> FT_OK Then 'Error End If End Sub Public Function FHZWrite(sTT As String, sData As String) Dim sOut As String * 256 Dim cSum As Integer, i As Integer Dim sLenWritten As Long FHZWrite = False cSum = 0 For i = 1 To Len(sData) Step 2 cSum = cSum + Val("&h" & Mid$(sData, i, 2)) Next i sOut = Chr$(&H81) + Chr$((Len(sData) / 2) + 2) + Chr$(Val("&h" & sTT)) + Chr$(cSum And 255) For i = 0 To Len(sData) / 2 Mid$(sOut, 5 + i, 1) = Chr$(Val("&h" & Mid$(sData, (i * 2) + 1, 2))) Next i sLenWritten = 0 If FT_Write(lngHandle, sOut, (Len(sData) / 2) + 4, sLenWritten) <> FT_OK Then 'Error Exit Function Else ' Wrote: " & HexString$(sOut, sLenWritten) End If FHZWrite = True End Function Public Function FHZRead(sTT As String, sData As String) As Boolean Dim lByte As Long Dim lLen As Long Dim lTT As Long Dim lBC As Long Dim strReadBuffer As String * 256 Dim s$ Dim lngBytesRead As Long Dim lngBytesToRead As Long Dim lngTotalBytesRead As Long Dim ftStatus As Long ' Erstmal die 81 suchen sTT = "": sData = "" FHZRead = False Do lByte = FHZReadByte() If lByte < 0 Then Exit Function Loop Until (lByte = &H81) ' Dann die Länge lLen = FHZReadByte() If lLen < 0 Then Exit Function ' Dann TT lTT = FHZReadByte() If lTT < 0 Then Exit Function ' Dann BC lBC = FHZReadByte() If lBC < 0 Then Exit Function ' Dann die Daten lLen = lLen - 2 s$ = "" lngTotalBytesRead = 0 Do lngBytesRead = 0 ftStatus = FT_Read(lngHandle, strReadBuffer, lLen, lngBytesRead) If (ftStatus = FT_OK) Or (ftStatus = FT_IO_ERROR) Then If lngBytesRead > 0 Then s$ = s$ + Left(strReadBuffer, lngBytesRead) lngTotalBytesRead = lngTotalBytesRead + lngBytesRead Else Exit Function End If Else Exit Function End If Loop Until (lngTotalBytesRead = lLen) ' 2Do : Checksum prüfen sData = HexString$(s$, lLen) sTT = HexString$(Chr$(lTT), 1) FHZRead = True End Function Public Function FHZReadByte() As Long Dim strReadBuffer As String * 256 Dim lngBytesRead As Long Dim ftStatus As Long Do lngBytesRead = 0 ftStatus = FT_Read(lngHandle, strReadBuffer, 1, lngBytesRead) If (ftStatus = FT_OK) Or (ftStatus = FT_IO_ERROR) Then If lngBytesRead = 0 Then FHZReadByte = -1 Exit Function End If Else FHZReadByte = -1 Exit Function End If Loop Until (lngBytesRead = 1) FHZReadByte = Asc(Mid$(strReadBuffer, 1, 1)) End Function Public Function FHZDataAvailable() As Boolean Dim lngBytes As Long If FT_GetQueueStatus(lngHandle, lngBytes) = FT_OK And lngBytes > 0 Then FHZDataAvailable = True Else FHZDataAvailable = False End If End Function Viel Spass !!!! Mike]]> mike1234 Thu, 25 May 2006 21:51:11 +0100 http://fhz4linux.info//tiki-view_forum_thread.php?forumId=1&comments_parentId=0 <j(DOT)lorenz(AT)gmx(DOT)de> Sun, 14 May 2006 08:49:48 +0100