Buchempfehlung
Mikrocomputertechnik mit Controllern der Atmel AVR-RISC-Familie
Mikrocomputertechnik mit Controllern der Atmel AVR-RISC-Familie
Umfassend, aber leicht verständlich führt dieses Buch in die Programmierung von ATMEL AVR Mikrocontrollern ein. [Mehr Infos...]
FreeBASIC-Chat
Es sind Benutzer im FreeBASIC-Chat online.
(Stand:  )
FreeBASIC bei Twitter
Twitter FreeBASIC-Nachrichten jetzt auch über Twitter erhalten. Follow us!

fb:porticula NoPaste

Info
Info / Hilfe
Liste
Übersicht / Liste
Neu
Datei hochladen
Suche
Quellcode suchen
Download
Dateidownload

TSNEX_helper.bi

Uploader:MitgliedThePuppetMaster
Datum/Zeit:21.01.2008 21:19:30

'#####################################################################################################
'#####################################################################################################
' TSNE_V2 - TCP Socket Networking [Eventing] Version: 2
' Helper-Bibliothek für TSNEX
'#####################################################################################################
'#####################################################################################################
' 2008 By.: /_\ DeltaLab's - Deutschland
' Autor: Martin Wiemann
'#####################################################################################################



'##############################################################################################################
Const Base64_String = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/"
Dim Shared Base64_Rev64() As UByte

#IF DEFINED(__FB_LINUX__)
    Const TSNEX_Seperator = "/"
#ELSEIF DEFINED(__FB_WIN32__)
    Const TSNEX_Seperator = "\"
#ELSE
    #error "Unsupported platform"
#ENDIF



'##############################################################################################################
Declare Function    URL_Split               (V_URL as String, ByRef B_Protocol as String, ByRef B_Host as String, ByRef B_Port as UShort = 0, ByRef B_Path as String = "", ByRef B_File as String = "", ByRef B_FileType as String = "", ByRef B_Username as String = "", ByRef B_Password as String = "") as Long
Declare Function    Base64_Encode           (V_Source As String) As String
Declare Function    TSNEX_Get_GURUCode      (V_GURUID as Long) as String
Declare Function    InStrRev                (ByVal V_Data as String, V_Search as String) as Long





'##############################################################################################################
Function TSNEX_Get_GURUCode(V_GURUID as Long) as String
Select Case V_GURUID
    case 1: Return "Unbekanntes Protokoll (HTTP / FTP / Telnet / ...)."
    case 2: Return "Protokoll wird von dieser Funktion nicht unterstützt."
    case 3: Return "Keine Daten in der Antwort vom Server."
    case 4: Return "Konnte keine Header-Informationen in der Antwort vom Server finden."
    case 5: Return "Proxy-Port fehlt."
    case 6: Return "Zugangsdaten falsch."
    case 7: Return "Angaben für PASIVEN FTP-Modus nicht gefunden."
    case 8: Return "Zieldatei existiert bereits."
    case 9: Return "Ziel Dateiname fehlt."
    case 10: Return "Kann Zieldatei nicht öffnen."
    case 11: Return "Konnte Zieldatei nicht löschen."
    case 12: Return "Quelldatei nicht vorhanden."
    case 13: Return "FTP Zugriff verweigert."
    case 100: Return "Anfrage erfolgreich, jedoch sind Fehler bei der Auswertung aufgetreten."
    case else: Return TSNE_GetGURUCode(V_GURUID)
End Select
End Function





'##############################################################################################################
Function URL_Split(V_URL as String, ByRef B_Protocol as String, ByRef B_Host as String, ByRef B_Port as UShort = 0, ByRef B_Path as String = "", ByRef B_File as String = "", ByRef B_FileType as String = "", ByRef B_Username as String = "", ByRef B_Password as String = "") as Long
Dim XPos as UInteger
Dim D as String = V_URL
XPos = InStr(1, D, "://")
If XPos <= 0 Then Return 1
B_Protocol = lcase(mid(D, 1, XPos - 1))
D = Mid(D, XPos + 3)
XPos = InStr(1, D, "/")
If XPos > 0 Then
    B_Host = Mid(D, 1, XPos - 1): B_Path = Mid(D, XPos + 1)
Else: B_Host = D
End If
XPos = InStr(1, B_Host, "@")
If XPos > 0 Then B_Username = Mid(B_Host, 1, XPos - 1): B_Host = Mid(B_Host, XPos + 1)
XPos = InStr(1, B_Host, ":")
If XPos > 0 Then B_Port = Val(Mid(B_Host, XPos + 1)): B_Host = Mid(B_Host, 1, XPos - 1)
XPos = InStr(1, B_Username, ":")
If XPos > 0 Then B_Password = Mid(B_Username, XPos + 1): B_Username = Mid(B_Username, 1, XPos - 1)
XPos = InStr(1, B_Path, "/")
If XPos > 0 Then
    B_File = Mid(B_Path, XPos + 1): B_Path = Mid(B_Path, 1, XPos - 1)
Else: B_File = B_Path: B_Path = ""
End If
XPos = InStr(1, B_File, ".")
If XPos > 0 Then B_FileType = Mid(B_File, XPos + 1): B_File = Mid(B_File, 1, XPos - 1)
Return 0
End Function





'###############################################################################################################
Sub Base64_ReverseCode(V_Code() As UByte, B_Rev() As UByte)
Dim X As UInteger
ReDim B_Rev(255) as UByte
For X = 0 To UBound(V_Code)-1
    B_Rev(V_Code(X)) = X
Next
End Sub
'---------------------------------------------------------------------------------------------------------------
Function Base64_Encode(V_Source As String) As String
Dim X as ULong
Dim B64() As Byte
ReDim B64(63) As Byte
For X = 1 to Len(Base64_String)
    B64(X-1) = Asc(Mid(Base64_String, X, 1))
Next
Base64_ReverseCode(B64(), Base64_Rev64())
Dim XL As ULong
Dim SourceB() As UByte
Dim XRest As ULong
Dim XN As ULong
Dim Result() As UByte
Dim XCNT as ULong
Dim Y As ULong
Dim c1 As Integer
Dim c2 As Integer
Dim c3 As Integer
Dim w(4) As Integer
XL = Len(V_Source)
If XL = 0 Then Return ""
Redim SourceB(XL) as UByte
For X = 1 to XL
    SourceB(X-1) = Asc(Mid(V_Source, X, 1))
Next
XRest = XL Mod 3
If XRest > 0 Then
    XN = ((XL \ 3) + 1) * 3
    ReDim Preserve V_SourceB(XL - 1) as UByte
Else: XN = XL
End If
ReDim Result(4 * XN / 3 - 1)
XCNT = 0
For X = 0 To XN / 3 - 1
    Y = 3 * X
    c1 = SourceB(Y)
    c2 = SourceB(Y + 1)
    c3 = SourceB(Y + 2)
    w(1) = Int(c1 / 4)
    w(2) = (c1 And 3) * 16 + Int(c2 / 16)
    w(3) = (c2 And 15) * 4 + Int(c3 / 64)
    w(4) = c3 And 63
    Y = 4 * X
    Result(Y) = B64(w(1))
    Result(Y + 1) = B64(w(2))
    Result(Y + 2) = B64(w(3))
    Result(Y + 3) = B64(w(4))
Next
Select Case XRest
    Case 0
    Case 1
        Result(UBound(Result)) = 61
        Result(UBound(Result) - 1) = 61
    Case 2: Result(UBound(Result)) = 61
End Select
Dim D as String
For X = 0 to UBound(Result)
    D += Chr(Result(X))
Next
Return D
End Function




'##############################################################################################################
Function InStrRev(ByVal V_Data as String, V_Search as String) as Long
Dim X as Long
Dim SL as Long
SL = Len(V_Search)
For X = Len(V_Data) - SL to 1 Step - 1
    If Mid(V_Data, X, SL) = V_Search then Return X
Next
End Function