Wer ist online?
Buchempfehlung
FreeBASIC-Chat
FreeBASIC-Nachrichten jetzt auch über Twitter erhalten. Follow us!fb:porticula NoPaste
RS232lib
| Uploader: |  AndT |
| Datum/Zeit: | 13.04.2009 11:06:11 |
' Programmed by AndT
SUB OPENCOM
PRINT "OPEN COM"
OPEN COM "COM1:115200,N,8,1,CS,DS" FOR BINARY AS #1
OPEN "LOGDATEI.BIN" FOR BINARY AS #2
PRINT "READY FOR TRANSFER"
END SUB
SUB CLOSECOM
PRINT "CLOSE COM"
CLOSE #1
PRINT "COM CLOSED"
END SUB
SUB SEND (VAULE AS UBYTE)
DIM AS UBYTE CVAULE
PUT #1,,VAULE
PUT #2,,VAULE
END SUB
Function RECV as UBYTE
DIM AS UBYTE TMP
GET #1,,TMP
PUT #2,,TMP
RETURN TMP
END FUNCTION
SUB SendString (TEXT AS STRING)
DIM AS UBYTE LENGTH = LEN(TEXT)
If LENGTH > 255 Then Print "Text overzized! (not more then 255 chars)" : EXIT SUB
SEND LENGTH
FOR I AS INTEGER = 1 to LEN(TEXT)
SEND ASC(TEXT,I)
NEXT
END SUB
Function ReadString as String
dim as ubyte length
dim as string text
Length = RECV
for i as integer = 1 to length
text + = CHR(RECV)
next
return text
end Function
SUB SendVaule (VAULE AS INTEGER)
SendString MKI(VAULE)
END SUB
Function RECVVaule as Integer
Return CVI(ReadString)
End Function
Function SendFile (Filepath as String,Target as String) as Ubyte
cls
CLOSECOM
OPEN Filepath for binary as #1
dim as integer length = lof(1)
if length = 0 then print "cancel - length was zero.." : exit function
Print "Create Filebuffer.."
dim as ubyte File (1 to lof(1)+1)
if ubound(file)-lbound(file) <> length then Print "cancel - buffer error" : exit function
Print "ReadFile.."
get #1,,file()
close #1
OPENCOM
Print "Sending Data.."
SendVaule length
PRINT "TRANSFER..";
DIM AS UBYTE P = CSRLIN,OP
DIM AS INTEGER FS,OS
For I as Integer = 1 to Length
FS = I*100/length
IF FS > OS THEN OS = FS : LOCATE P,16 : PRINT FS
Send File(I)
Next
Print "done."
Print "Sending Target..";
SendString Target
Print "done."
Return 1
End Function
Sub ReciveFile
opencom
dim as integer length = Recvvaule
if length = -1 then print "File Error by Uploadclient"
dim as ubyte File(1 to length)
PRINT "TRANSFER.."
for i as integer = 1 to length
IF INKEY <> "" THEN EXIT FOR
File(I) = Recv
NEXT
dim as string Filename = ReadString
CLOSECOM
open Filename for binary as #1
put #1,,file()
close #1
END SUB