fb:porticula NoPaste

Info / Hilfe Liste
Übersicht / Liste Neu
Datei hochladen Suche
Quellcode suchen
Dateidownload
TSNEX_helper.bi

Uploader:	ThePuppetMaster
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