Wer ist online?
Buchempfehlung
FreeBASIC-Chat
FreeBASIC-Nachrichten jetzt auch über Twitter erhalten. Follow us!fb:porticula NoPaste
TSNEX_V3.bi
| Uploader: |  ThePuppetMaster |
| Datum/Zeit: | 27.01.2009 01:36:45 |
'#####################################################################################################
'#####################################################################################################
' TSNEX_V3 - Extension Modul für TSNE_V3
'#####################################################################################################
'#####################################################################################################
' 2009 By.: /_\ DeltaLab's - Deutschland
' Autor: Martin Wiemann
'#####################################################################################################
#IFNDEF _TSNEX_
#DEFINE _TSNEX_
'>...
'##############################################################################################################
#include once "TSNE_V3.bi"
#include once "vbcompat.bi"
'##############################################################################################################
#IF DEFINED(__FB_LINUX__)
Const TSNEX_Seperator = "/"
#ELSEIF DEFINED(__FB_WIN32__)
Const TSNEX_Seperator = "\"
#ELSE
#error "Unsupported platform"
#ENDIF
'##############################################################################################################
Private Const TSNEX_Const_NoError as Integer = 1
Private Const TSNEX_Const_UnknowError as Integer = 0
Private Const TSNEX_Const_URLorHostDataMissing as Integer = -1000
Private Const TSNEX_Const_DisconnectedBeforSuccess as Integer = -1001
Private Const TSNEX_Const_TimeOutBeforSuccess as Integer = -1002
Private Const TSNEX_Const_TransmissionError as Integer = -1003
Private Const TSNEX_Const_PathFileError as Integer = -1004
Private Const TSNEX_Const_TargetAlreadyExist as Integer = -1005
Private Const TSNEX_Const_TargetPathNotFound as Integer = -1006
Private Const TSNEX_Const_ProtocolNotSupported as Integer = -1007
Private Const TSNEX_Const_EMailSyntaxError as Integer = -1008
Private Const TSNEX_Const_MissingParameter as Integer = -1009
'##############################################################################################################
Private Const TSNEX_Base64_String = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/"
'--------------------------------------------------------------------------------------------------------------
Dim Shared TSNEX_Base64_Rev64() As UByte
'##############################################################################################################
#IFNDEF URL_Type
Type URL_Type
V_Protocol as String
V_Host as String
V_Port as UShort
V_Path as String
V_File as String
V_FileType as String
V_Username as String
V_Password as String
End Type
#ENDIF
'##############################################################################################################
Enum TSNEX_ConType_Enum
TSNEX_CE_Unknown = 0
TSNEX_CE_HTTP = 1
TSNEX_CE_FTP = 2
TSNEX_CE_FTP_Data = 3
TSNEX_CE_SMTP = 4
End Enum
'--------------------------------------------------------------------------------------------------------------
Enum TSNEX_CMDType_Enum
TSNEX_ME_FTP_List = 0
TSNEX_ME_FTP_Download = 1
TSNEX_ME_FTP_UpLoad = 2
TSNEX_ME_FTP_Delete = 3
TSNEX_ME_SMTP_Send = 4
End Enum
'--------------------------------------------------------------------------------------------------------------
Enum TSNEX_State_Enum
TSNEX_SE_Init = 0
TSNEX_SE_Connected = 1
TSNEX_SE_Login = 2
TSNEX_SE_Ready = 3
TSNEX_SE_Info = 4
TSNEX_SE_TX1 = 5
TSNEX_SE_TX2 = 6
TSNEX_SE_TX3 = 7
TSNEX_SE_TX4 = 8
TSNEX_SE_TX5 = 9
TSNEX_SE_TX6 = 10
End Enum
'--------------------------------------------------------------------------------------------------------------
Type TSNEX_Mem_Type
V_Next as TSNEX_Mem_Type Ptr
V_Data as String
End Type
'--------------------------------------------------------------------------------------------------------------
Type TSNEX_Con_Type
V_InUse as UByte
V_TSNEID as UInteger
V_State as TSNEX_State_Enum
V_URLType as URL_Type
V_Type as TSNEX_ConType_Enum
V_CMD as TSNEX_CMDType_Enum
V_Target as String
V_Data(8) as String
T_TimeOut as Double
T_Data as String
T_FID as Integer
T_MemF as TSNEX_Mem_Type Ptr
T_MemL as TSNEX_Mem_Type Ptr
T_FileSize as UInteger
T_SubTID as UInteger
T_PreTID as UInteger
T_HolTID as UInteger
T_CallBack as Sub (V_Max as UInteger, V_Value as UInteger)
End Type
'--------------------------------------------------------------------------------------------------------------
Dim Shared G_TSNEX_CD() as TSNEX_Con_Type
Dim Shared G_TSNEX_CC as UInteger
Dim Shared G_TSNEX_Mutex as Any Ptr
'##############################################################################################################
Sub TSNEX_Construct () Constructor
G_TSNEX_Mutex = MutexCreate()
End Sub
'--------------------------------------------------------------------------------------------------------------
Sub TSNEX_Destruct () Destructor
MutexLock(G_TSNEX_Mutex)
MutexUnLock(G_TSNEX_Mutex)
MutexDestroy(G_TSNEX_Mutex)
End Sub
'##############################################################################################################
Function TSNEX_GetGURUCode(V_GuruCode as Integer) as String
Select Case V_GuruCode
Case TSNEX_Const_URLorHostDataMissing: Return "URL corrupt or Host / Port / Username / Passwort missing / corrupt!"
Case TSNEX_Const_DisconnectedBeforSuccess: Return "Dissconnected befor operation was successfully! or error while operation like access denied / not exist / or so one!"
Case TSNEX_Const_TimeOutBeforSuccess: Return "Operation Timeout befor operation successfully!"
Case TSNEX_Const_TransmissionError: Return "Error while communication!"
Case TSNEX_Const_PathFileError: Return "Path or / and File error!"
Case TSNEX_Const_TargetAlreadyExist: Return "Target / Source path / file already exist!"
Case TSNEX_Const_TargetPathNotFound: Return "Target / Source path / file not found!"
Case TSNEX_Const_ProtocolNotSupported: Return "Selected protocol was not supported by this function! (SMTP:// FTP:// HTTP:// ...)"
Case TSNEX_Const_EMailSyntaxError: Return "E-Mail address syntax is wrong!"
Case TSNEX_Const_MissingParameter: Return "Missing function parameter(s)!"
Case Else: Return TSNE_GetGURUCode(V_GuruCode)
End Select
End Function
'##############################################################################################################
#IFNDEF URL_Split
Private Function URL_Split(V_URL as String, ByRef B_Cut as URL_Type) as Integer
Dim TCut as URL_Type
With TCut
Dim XPos as UInteger
Dim D as String = V_URL
XPos = InStr(1, D, "://")
If XPos <= 0 Then Return 1
.V_Protocol = lcase(mid(D, 1, XPos - 1))
If InStr(1, .V_Protocol, " ") > 0 Then Return 1
If InStr(1, .V_Protocol, Chr(9)) > 0 Then Return 1
D = Mid(D, XPos + 3)
XPos = InStr(1, D, "/")
If XPos > 0 Then
.V_Host = Mid(D, 1, XPos - 1): .V_Path = Mid(D, XPos)
Else: .V_Host = D
End If
XPos = InStr(1, .V_Host, "@")
If XPos > 0 Then .V_Username = Mid(.V_Host, 1, XPos - 1): .V_Host = Mid(.V_Host, XPos + 1)
XPos = InStr(1, .V_Host, ":")
If XPos > 0 Then .V_Port = Val(Mid(.V_Host, XPos + 1)): .V_Host = Mid(.V_Host, 1, XPos - 1)
XPos = InStr(1, .V_Username, ":")
If XPos > 0 Then .V_Password = Mid(.V_Username, XPos + 1): .V_Username = Mid(.V_Username, 1, XPos - 1)
XPos = InStrRev(.V_Path, "/")
If XPos > 0 Then
.V_File = Mid(.V_Path, XPos + 1): .V_Path = Mid(.V_Path, 1, XPos)
Else: .V_File = .V_Path: .V_Path = ""
End If
XPos = InStr(1, .V_File, ".")
If XPos > 0 Then .V_FileType = Mid(.V_File, XPos + 1): .V_File = Mid(.V_File, 1, XPos - 1)
End With
B_Cut = TCut
Return 0
End Function
#ENDIF
'###############################################################################################################
Private Sub TSNEX_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
'---------------------------------------------------------------------------------------------------------------
Private Function TSNEX_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(TSNEX_Base64_String)
B64(X-1) = Asc(Mid(TSNEX_Base64_String, X, 1))
Next
TSNEX_Base64_ReverseCode(B64(), TSNEX_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 TSNEX_WaitState(V_TID as UInteger, V_State as UInteger) as Integer
MutexLock(G_TSNEX_Mutex)
G_TSNEX_CD(V_TID).T_TimeOut = Timer() + 60
MutexUnLock(G_TSNEX_Mutex)
Do
MutexLock(G_TSNEX_Mutex)
If G_TSNEX_CD(V_TID).V_State = V_State Then MutexUnLock(G_TSNEX_Mutex): Return TSNEX_Const_NoError
If TSNE_IsClosed(G_TSNEX_CD(V_TID).V_TSNEID) = 1 Then MutexUnLock(G_TSNEX_Mutex): Return TSNEX_Const_DisconnectedBeforSuccess
If G_TSNEX_CD(V_TID).T_TimeOut < Timer() Then MutexUnLock(G_TSNEX_Mutex): Return TSNEX_Const_TimeOutBeforSuccess
MutexUnLock(G_TSNEX_Mutex)
Sleep 1, 1
Loop
End Function
'##############################################################################################################
Sub TSNEX_Disconnected(ByVal V_TSNEID as UInteger)
'Print "DIS:"; V_TSNEID
'if V_TSNEID = 1 then
' Dim X as uinteger ptr
' Print *X
'End If
MutexLock(G_TSNEX_Mutex)
For X as UInteger = 1 to G_TSNEX_CC
If G_TSNEX_CD(X).V_InUse = 1 Then
If G_TSNEX_CD(X).V_TSNEID = V_TSNEID Then
G_TSNEX_CD(X).V_InUse = 0
MutexUnLock(G_TSNEX_Mutex): Exit Sub
End If
EndIf
Next
MutexUnLock(G_TSNEX_Mutex)
End Sub
'--------------------------------------------------------------------------------------------------------------
Sub TSNEX_Connected(ByVal V_TSNEID as UInteger)
'Print "CON:"; V_TSNEID
MutexLock(G_TSNEX_Mutex)
For X as UInteger = 1 to G_TSNEX_CC
If G_TSNEX_CD(X).V_InUse <> 0 Then
If G_TSNEX_CD(X).V_TSNEID = V_TSNEID Then
G_TSNEX_CD(X).V_State = TSNEX_SE_Connected
If G_TSNEX_CD(X).T_FID <> 0 Then Close G_TSNEX_CD(X).T_FID
MutexUnLock(G_TSNEX_Mutex): Exit Sub
End If
EndIf
Next
MutexUnLock(G_TSNEX_Mutex)
End Sub
'--------------------------------------------------------------------------------------------------------------
Sub TSNEX_NewData(ByVal V_TSNEID as UInteger, ByRef V_Data as String)
MutexLock(G_TSNEX_Mutex)
Dim XID as UInteger
For X as UInteger = 1 to G_TSNEX_CC
If G_TSNEX_CD(X).V_InUse <> 0 Then
If G_TSNEX_CD(X).V_TSNEID = V_TSNEID Then XID = X: Exit For
EndIf
Next
If XID = 0 Then MutexUnLock(G_TSNEX_Mutex): Exit Sub
Dim XFBCRLF as String = Chr(13, 10)
Dim T as String
Dim T1 as String
Dim T2 as UShort
Dim XCMD as UInteger
Dim XPos as UInteger
Dim RV as Integer
Dim XLCMD as UByte
Dim TData as String = G_TSNEX_CD(XID).T_Data & V_Data
Dim TCMDE as TSNEX_CMDType_Enum = G_TSNEX_CD(XID).V_CMD
Dim XURL as URL_Type = G_TSNEX_CD(XID).V_URLType
Dim XTSNEID as UInteger
Dim TXID as UInteger
Dim TCC as TSNEX_Con_Type
Dim TFID as Integer = G_TSNEX_CD(XID).T_FID
If G_TSNEX_CD(XID).T_PreTID <> 0 Then G_TSNEX_CD(G_TSNEX_CD(XID).T_PreTID).T_TimeOut = Timer() + 30
G_TSNEX_CD(XID).T_Data = ""
Dim TMX as UInteger
Dim TMV as UInteger
Dim TCallBack as Sub (V_Max as UInteger, V_Value as UInteger)
MutexUnLock(G_TSNEX_Mutex)
Select Case G_TSNEX_CD(XID).V_Type
Case TSNEX_CE_FTP_Data
' Print "NDA:"; V_TSNEID; " >"; V_Data; "<"
If TFID = 0 Then
MutexLock(G_TSNEX_Mutex)
With G_TSNEX_CD(XID)
If .T_MemL <> 0 Then
.T_MemL->V_Next = CAllocate(SizeOf(TSNEX_Mem_Type))
.T_MemL = .T_MemL->V_Next
Else
.T_MemL = CAllocate(SizeOf(TSNEX_Mem_Type))
.T_MemF = .T_MemL
EndIf
.T_MemL->V_Data = TData
End With
MutexUnLock(G_TSNEX_Mutex)
Else
Print #TFID, TData;
MutexLock(G_TSNEX_Mutex)
G_TSNEX_CD(XID).T_FileSize += Len(TData)
TMV = G_TSNEX_CD(XID).T_FileSize
If G_TSNEX_CD(XID).T_PreTID <> 0 Then
TMX = G_TSNEX_CD(G_TSNEX_CD(XID).T_PreTID).T_FileSize
TCallBack = G_TSNEX_CD(G_TSNEX_CD(XID).T_PreTID).T_CallBack
End If
MutexUnLock(G_TSNEX_Mutex)
If TCallBack <> 0 Then TCallBack(TMX, TMV)
EndIf
Case TSNEX_CE_FTP
' Print "NDA:"; V_TSNEID; " >"; V_Data; "<"
If Len(TData) > 100000 Then TSNE_Disconnect(V_TSNEID): Exit Sub
Do
XPos = InStr(1, TData, XFBCRLF)
If XPos = 0 Then
MutexLock(G_TSNEX_Mutex)
G_TSNEX_CD(XID).T_Data = TData
MutexUnLock(G_TSNEX_Mutex)
Exit Sub
End If
T = Mid(TData, 1, XPos - 1): TData = Mid(TData, XPos + 2)
If Mid(T, 4, 1) = "-" Then XLCMD = 0 Else XLCMD = 1
XCMD = Val(Left(T, 3)): T = Mid(T, 5)
' Print " >"; V_TSNEID; "<___>"; XCMD; "<___>"; T; "<"
If XLCMD = 1 Then
' Print "CMD: >"; V_TSNEID; "<___>"; XCMD; "<___>"; T; "<"
Select Case XCMD
case 150
Select case TCMDE
case TSNEX_ME_FTP_UpLoad
MutexLock(G_TSNEX_Mutex)
If G_TSNEX_CD(XID).V_State = TSNEX_SE_Info Then
XTSNEID = G_TSNEX_CD(XID).T_HolTID
TFID = FreeFile
If Open(G_TSNEX_CD(XID).V_Target for Binary as #TFID) <> 0 Then
MutexUnLock(G_TSNEX_Mutex)
TSNE_Disconnect(XTSNEID)
TSNE_Disconnect(V_TSNEID)
Exit Sub
End If
TCallBack = G_TSNEX_CD(XID).T_CallBack
MutexUnLock(G_TSNEX_Mutex)
TMX = Lof(TFID)
T = Space(TSNE_INT_BufferSize)
If TCallBack <> 0 Then TCallBack(TMX, 0)
For X as UInteger = 1 to TMX Step TSNE_INT_BufferSize
If TMX - X < TSNE_INT_BufferSize Then T = Space(TMX - X + 1)
Get #TFID, X, T
RV = TSNE_Data_Send(XTSNEID, T)
If RV <> TSNE_Const_NoError Then
Close TFID
TSNE_Disconnect(XTSNEID)
TSNE_Disconnect(V_TSNEID)
Exit Sub
End If
If TCallBack <> 0 Then TCallBack(TMX, X)
Next
If TCallBack <> 0 Then TCallBack(TMX, TMX)
TSNE_Disconnect(XTSNEID)
Else: MutexUnLock(G_TSNEX_Mutex)
End If
End select
case 200
Select case TCMDE
case TSNEX_ME_FTP_List, TSNEX_ME_FTP_Download, TSNEX_ME_FTP_UpLoad
TSNE_Data_Send(V_TSNEID, "PASV" & XFBCRLF)
End select
case 220: TSNE_Data_Send(V_TSNEID, "USER " & XURL.V_Username & XFBCRLF)
case 221'Quit
case 226
Select case TCMDE
Case TSNEX_ME_FTP_List, TSNEX_ME_FTP_DownLoad
case TSNEX_ME_FTP_UpLoad
MutexLock(G_TSNEX_Mutex)
If G_TSNEX_CD(XID).V_State = TSNEX_SE_Info Then
MutexUnLock(G_TSNEX_Mutex)
MutexLock(G_TSNEX_Mutex): G_TSNEX_CD(XID).V_State = TSNEX_SE_Ready: MutexUnLock(G_TSNEX_Mutex)
TSNE_Disconnect(V_TSNEID): Exit Sub
Else
G_TSNEX_CD(XID).V_State = TSNEX_SE_Info
MutexUnLock(G_TSNEX_Mutex)
TSNE_Data_Send(V_TSNEID, "PASV" & XFBCRLF)
End If
Case Else
MutexLock(G_TSNEX_Mutex): G_TSNEX_CD(XID).V_State = TSNEX_SE_Ready: MutexUnLock(G_TSNEX_Mutex)
TSNE_Disconnect(V_TSNEID): Exit Sub
End Select
case 227
XPos = InStr(1, T, "("): If XPos <= 0 Then TSNE_Disconnect(V_TSNEID): Exit Sub
T = Mid(T, XPos + 1)
XPos = InStr(1, T, ")"): If XPos <= 0 Then TSNE_Disconnect(V_TSNEID): Exit Sub
T = Mid(T, 1, XPos - 1)
For Y as UInteger = 1 to Len(T)
XPos = InStr(1, T, ",")
If XPos > 0 Then
Select Case Y
Case 1 To 4: T1 += Left(T, XPos - 1) & ".": T = Mid(T, XPos + 1)
Case Else: T2 = (256 * Val(Left(T, XPos - 1))) + Val(Mid(T, XPos + 1)): Exit For
End Select
End If
Next
If (T1 = "") or (T2 <= 0) Then TSNE_Disconnect(V_TSNEID): Exit Sub
T1 = Left(T1, Len(T1) - 1)
MutexLock(G_TSNEX_Mutex)
RV = TSNE_Create_Client(XTSNEID, T1, T2, @TSNEX_Disconnected, @TSNEX_Connected, @TSNEX_NewData)
If RV <> TSNE_Const_NoError Then MutexUnLock(G_TSNEX_Mutex): TSNE_Disconnect(V_TSNEID): Exit Sub
For X as UInteger = 1 to G_TSNEX_CC
If G_TSNEX_CD(X).V_InUse = 0 Then TXID = X: Exit For
Next
If TXID = 0 Then
G_TSNEX_CC += 1
TXID = G_TSNEX_CC
Redim Preserve G_TSNEX_CD(G_TSNEX_CC) as TSNEX_Con_Type
End If
G_TSNEX_CD(TXID) = TCC
With G_TSNEX_CD(TXID)
.V_InUse = 2
.V_TSNEID = XTSNEID
.V_State = TSNEX_SE_Init
.V_URLType = XURL
.T_PreTID = XID
.V_Type = TSNEX_CE_FTP_Data
End With
MutexUnLock(G_TSNEX_Mutex)
RV = TSNEX_WaitState(TXID, TSNEX_SE_Connected)
If RV <> TSNEX_Const_NoError Then TSNE_Disconnect(V_TSNEID): TSNE_Disconnect(XTSNEID): Exit Sub
Select case TCMDE
case TSNEX_ME_FTP_List: TSNE_Data_Send(V_TSNEID, "LIST" & XFBCRLF)
case TSNEX_ME_FTP_Download, TSNEX_ME_FTP_UpLoad
MutexLock(G_TSNEX_Mutex)
If G_TSNEX_CD(XID).V_State <> TSNEX_SE_Info Then
MutexUnLock(G_TSNEX_Mutex)
If XURL.V_FileType <> "" Then
TSNE_Data_Send(V_TSNEID, "LIST " & XURL.V_File & "." & XURL.V_FileType & XFBCRLF)
Else: TSNE_Data_Send(V_TSNEID, "LIST " & XURL.V_File & XFBCRLF)
End If
Else
Select case TCMDE
case TSNEX_ME_FTP_Download
G_TSNEX_CD(TXID).T_FID = FreeFile
If Open(G_TSNEX_CD(XID).V_Target for Binary as #G_TSNEX_CD(TXID).T_FID) <> 0 Then
G_TSNEX_CD(TXID).T_FID = 0
MutexUnLock(G_TSNEX_Mutex)
TSNE_Disconnect(V_TSNEID)
Exit Sub
End If
MutexUnLock(G_TSNEX_Mutex)
If XURL.V_FileType <> "" Then
TSNE_Data_Send(V_TSNEID, "RETR " & XURL.V_File & "." & XURL.V_FileType & XFBCRLF)
Else: TSNE_Data_Send(V_TSNEID, "RETR " & XURL.V_File & XFBCRLF)
End If
case TSNEX_ME_FTP_UpLoad
G_TSNEX_CD(XID).T_HolTID = XTSNEID
MutexUnLock(G_TSNEX_Mutex)
If XURL.V_FileType <> "" Then
TSNE_Data_Send(V_TSNEID, "STOR " & XURL.V_File & "." & XURL.V_FileType & XFBCRLF)
Else: TSNE_Data_Send(V_TSNEID, "STOR " & XURL.V_File & XFBCRLF)
End If
Case Else: MutexUnLock(G_TSNEX_Mutex)
End Select
End If
End select
Select Case TCMDE
case TSNEX_ME_FTP_List, TSNEX_ME_FTP_Download, TSNEX_ME_FTP_UpLoad
Select case TCMDE
case TSNEX_ME_FTP_List
TSNE_WaitClose(XTSNEID)
MutexLock(G_TSNEX_Mutex)
G_TSNEX_CD(XID).T_SubTID = TXID
G_TSNEX_CD(XID).V_State = TSNEX_SE_Ready
MutexUnLock(G_TSNEX_Mutex)
case TSNEX_ME_FTP_DownLoad
TSNE_WaitClose(XTSNEID)
MutexLock(G_TSNEX_Mutex)
G_TSNEX_CD(XID).T_SubTID = TXID
If G_TSNEX_CD(XID).V_State <> TSNEX_SE_Info Then
If G_TSNEX_CD(TXID).T_MemF = 0 Then MutexUnLock(G_TSNEX_Mutex): TSNE_Disconnect(V_TSNEID): Exit Sub
T1 = G_TSNEX_CD(TXID).T_MemF->V_Data
DeAllocate(G_TSNEX_CD(TXID).T_MemF)
G_TSNEX_CD(TXID).V_InUse = 0
MutexUnLock(G_TSNEX_Mutex)
T1 = Trim(Mid(T1, 11))
XPos = InStr(1, T1, " "): If XPos = 0 Then TSNE_Disconnect(V_TSNEID): Exit Sub
T1 = Trim(Mid(T1, XPos + 1))
XPos = InStr(1, T1, " "): If XPos = 0 Then TSNE_Disconnect(V_TSNEID): Exit Sub
T1 = Trim(Mid(T1, XPos + 1))
XPos = InStr(1, T1, " "): If XPos = 0 Then TSNE_Disconnect(V_TSNEID): Exit Sub
T1 = Trim(Mid(T1, XPos + 1))
XPos = InStr(1, T1, " "): If XPos = 0 Then TSNE_Disconnect(V_TSNEID): Exit Sub
T1 = Trim(Left(T1, XPos - 1))
MutexLock(G_TSNEX_Mutex)
G_TSNEX_CD(XID).T_FileSize = ValUInt(T1)
G_TSNEX_CD(XID).V_State = TSNEX_SE_Info
MutexUnLock(G_TSNEX_Mutex)
TSNE_Data_Send(V_TSNEID, "PASV" & XFBCRLF)
Else
G_TSNEX_CD(XID).V_State = TSNEX_SE_Ready
MutexUnLock(G_TSNEX_Mutex)
End If
Case TSNEX_ME_FTP_UpLoad
MutexLock(G_TSNEX_Mutex)
If G_TSNEX_CD(XID).V_State <> TSNEX_SE_Info Then
MutexUnLock(G_TSNEX_Mutex)
TSNE_WaitClose(XTSNEID)
MutexLock(G_TSNEX_Mutex)
G_TSNEX_CD(XID).T_SubTID = TXID
If G_TSNEX_CD(TXID).T_MemF <> 0 Then
DeAllocate(G_TSNEX_CD(TXID).T_MemF)
MutexUnLock(G_TSNEX_Mutex): TSNE_Disconnect(V_TSNEID)
Exit Sub
End If
MutexUnLock(G_TSNEX_Mutex)
Else: MutexUnLock(G_TSNEX_Mutex)
End If
Case Else: MutexUnLock(G_TSNEX_Mutex)
End Select
End Select
case 230: TSNE_Data_Send(V_TSNEID, "CWD " & XURL.V_Path & XFBCRLF)
case 250
Select case TCMDE
case TSNEX_ME_FTP_List, TSNEX_ME_FTP_DownLoad, TSNEX_ME_FTP_Upload
TSNE_Data_Send(V_TSNEID, "TYPE A" & XFBCRLF)
Case TSNEX_ME_FTP_Delete
MutexLock(G_TSNEX_Mutex)
If G_TSNEX_CD(XID).V_State <> TSNEX_SE_Info Then
G_TSNEX_CD(XID).V_State = TSNEX_SE_Info
MutexUnLock(G_TSNEX_Mutex)
If XURL.V_FileType <> "" Then
TSNE_Data_Send(V_TSNEID, "DELE " & XURL.V_File & "." & XURL.V_FileType & XFBCRLF)
Else: TSNE_Data_Send(V_TSNEID, "DELE " & XURL.V_File & XFBCRLF)
End If
Else
G_TSNEX_CD(XID).V_State = TSNEX_SE_Ready
MutexUnLock(G_TSNEX_Mutex)
End If
End Select
case 226
case 331: TSNE_Data_Send(V_TSNEID, "PASS " & XURL.V_Password & XFBCRLF)
Case 425: TSNE_Disconnect(V_TSNEID): Exit Sub
case 530: TSNE_Disconnect(V_TSNEID): Exit Sub
case 550: TSNE_Disconnect(V_TSNEID): Exit Sub
case else: TSNE_Disconnect(V_TSNEID): Exit Sub
End Select
End If
Loop
Case TSNEX_CE_SMTP
' Print "NDA:"; V_TSNEID; " >"; V_Data; "<"
If Len(TData) > 100000 Then TSNE_Disconnect(V_TSNEID): Exit Sub
Do
XPos = InStr(1, TData, XFBCRLF)
If XPos = 0 Then
MutexLock(G_TSNEX_Mutex)
G_TSNEX_CD(XID).T_Data = TData
MutexUnLock(G_TSNEX_Mutex)
Exit Sub
End If
T = Mid(TData, 1, XPos - 1): TData = Mid(TData, XPos + 2)
If Mid(T, 4, 1) = "-" Then XLCMD = 0 Else XLCMD = 1
XCMD = Val(Left(T, 3)): T = Mid(T, 5)
' Print " >"; V_TSNEID; "<___>"; XCMD; "<___>"; T; "<"
If XLCMD = 1 Then
Select Case XCMD
Case 220
XPos = InStrRev(T, " ")
If XPos > 0 Then T = Mid(T, XPos + 1)
MutexLock(G_TSNEX_Mutex)
Select Case UCase(T)
Case "ESMTP"
G_TSNEX_CD(XID).V_State = TSNEX_SE_TX1
MutexUnLock(G_TSNEX_Mutex)
TSNE_Data_Send(V_TSNEID, "EHLO TSNEX_E-Mail-Function" & Chr(13, 10))
Case Else
G_TSNEX_CD(XID).V_State = TSNEX_SE_TX3
MutexUnLock(G_TSNEX_Mutex)
TSNE_Data_Send(V_TSNEID, "HELO TSNEX_E-Mail-Function" & Chr(13, 10))
End Select
Case 221
MutexLock(G_TSNEX_Mutex)
G_TSNEX_CD(XID).V_State = TSNEX_SE_Ready
MutexUnLock(G_TSNEX_Mutex)
TSNE_Disconnect(V_TSNEID)
Case 235
MutexLock(G_TSNEX_Mutex)
G_TSNEX_CD(XID).V_State = TSNEX_SE_TX4
T = G_TSNEX_CD(XID).V_Data(1)
MutexUnLock(G_TSNEX_Mutex)
TSNE_Data_Send(V_TSNEID, "MAIL FROM:<" & T & ">" & Chr(13, 10))
Case 250
MutexLock(G_TSNEX_Mutex)
Select Case G_TSNEX_CD(XID).V_State
Case TSNEX_SE_TX1
MutexUnLock(G_TSNEX_Mutex)
TSNE_Data_Send(V_TSNEID, "AUTH LOGIN" & Chr(13, 10))
Case TSNEX_SE_TX3
G_TSNEX_CD(XID).V_State = TSNEX_SE_TX4
T = G_TSNEX_CD(XID).V_Data(1)
MutexUnLock(G_TSNEX_Mutex)
TSNE_Data_Send(V_TSNEID, "MAIL FROM:<" & T & ">" & Chr(13, 10))
Case TSNEX_SE_TX4
G_TSNEX_CD(XID).V_State = TSNEX_SE_TX5
T = G_TSNEX_CD(XID).V_Data(2)
MutexUnLock(G_TSNEX_Mutex)
TSNE_Data_Send(V_TSNEID, "RCPT TO:<" & T & ">" & Chr(13, 10))
Case TSNEX_SE_TX5
G_TSNEX_CD(XID).V_State = TSNEX_SE_TX6
MutexUnLock(G_TSNEX_Mutex)
TSNE_Data_Send(V_TSNEID, "DATA" & Chr(13, 10))
Case TSNEX_SE_TX6
MutexUnLock(G_TSNEX_Mutex)
TSNE_Data_Send(V_TSNEID, "QUIT" & Chr(13, 10))
Case Else: MutexUnLock(G_TSNEX_Mutex)
End Select
Case 334
MutexLock(G_TSNEX_Mutex)
Select Case G_TSNEX_CD(XID).V_State
Case TSNEX_SE_TX1
G_TSNEX_CD(XID).V_State = TSNEX_SE_TX2
T = TSNEX_Base64_Encode(XURL.V_Username)
MutexUnLock(G_TSNEX_Mutex)
TSNE_Data_Send(V_TSNEID, T & Chr(13, 10))
Case TSNEX_SE_TX2
T = TSNEX_Base64_Encode(XURL.V_Password)
MutexUnLock(G_TSNEX_Mutex)
TSNE_Data_Send(V_TSNEID, T & Chr(13, 10))
Case Else: MutexUnLock(G_TSNEX_Mutex)
End Select
Case 354
MutexLock(G_TSNEX_Mutex)
T = "From: " & G_TSNEX_CD(XID).V_Data(1) & Chr(13, 10)
T += "To: " & G_TSNEX_CD(XID).V_Data(2) & Chr(13, 10)
T += "Subject: " & G_TSNEX_CD(XID).V_Data(3) & Chr(13, 10)
T += "Date: " & Format(Now(), "ddd, dd mmm yyyy hh:mm:ss") & Chr(13, 10)
T += Chr(13, 10)
MutexUnLock(G_TSNEX_Mutex)
TSNE_Data_Send(V_TSNEID, T)
MutexLock(G_TSNEX_Mutex)
T = G_TSNEX_CD(XID).V_Data(4) & Chr(13, 10) & "." & Chr(13, 10)
MutexUnLock(G_TSNEX_Mutex)
TSNE_Data_Send(V_TSNEID, T)
Case Else: TSNE_Disconnect(V_TSNEID)
End Select
End If
Loop
Case TSNEX_CE_HTTP
End Select
MutexUnLock(G_TSNEX_Mutex)
End Sub
'##############################################################################################################
Function TSNEX_FTP_List(V_HostOrURL as String, V_Port as UShort = 0, V_Username as String = "anonymous", V_Password as String = "anynomous@ano.nym", V_Path as String = "", R_FolderD() as String, ByRef R_FolderC as UInteger, R_FileD() as String, ByRef R_FileC as UInteger) as Integer
Dim XURL as URL_Type
If URL_Split(V_HostOrURL, XURL) = 1 Then
With XURL
.V_Protocol = "ftp"
.V_Host = V_HostOrURL
.V_Port = V_Port
.V_Username = V_Username
.V_Password = V_Password
.V_Path = V_Path
End With
End If
With XURL
If LCase(.V_Protocol) <> "ftp" Then Return TSNEX_Const_ProtocolNotSupported
If .V_Port = 0 Then .V_Port = 21
If .V_Path = "" Then .V_Path = "/"
If (.V_Host = "") or (.V_Port = 0) or (.V_Username = "") or (.V_Password = "") Then Return TSNEX_Const_URLorHostDataMissing
MutexLock(G_TSNEX_Mutex)
Dim XTSNEID as UInteger
Dim RV as Integer = TSNE_Create_Client(XTSNEID, .V_Host, .V_Port, @TSNEX_Disconnected, @TSNEX_Connected, @TSNEX_NewData)
If RV <> TSNE_Const_NoError Then MutexUnLock(G_TSNEX_Mutex): Return RV
End With
Dim XID as UInteger
For X as UInteger = 1 to G_TSNEX_CC
If G_TSNEX_CD(X).V_InUse = 0 Then XID = X: Exit For
Next
If XID = 0 Then
G_TSNEX_CC += 1
XID = G_TSNEX_CC
Redim Preserve G_TSNEX_CD(G_TSNEX_CC) as TSNEX_Con_Type
End If
Dim TCC as TSNEX_Con_Type
G_TSNEX_CD(XID) = TCC
With G_TSNEX_CD(XID)
.V_InUse = 1
.V_TSNEID = XTSNEID
.V_State = TSNEX_SE_Init
.V_URLType = XURL
.V_Type = TSNEX_CE_FTP
.V_CMD = TSNEX_ME_FTP_List
End With
MutexUnLock(G_TSNEX_Mutex)
R_FolderC = 0
R_FileC = 0
RV = TSNEX_WaitState(XID, TSNEX_SE_Ready): If RV <> TSNEX_Const_NoError Then MutexLock(G_TSNEX_Mutex): If G_TSNEX_CD(XID).V_TSNEID = XTSNEID Then G_TSNEX_CD(XID) = TCC: MutexUnLock(G_TSNEX_Mutex): Return RV
MutexLock(G_TSNEX_Mutex)
If G_TSNEX_CD(XID).T_SubTID = 0 Then MutexUnLock(G_TSNEX_Mutex): Return TSNEX_Const_TransmissionError
Dim D as String
Dim T as String
Dim TPtr as TSNEX_Mem_Type Ptr = G_TSNEX_CD(G_TSNEX_CD(XID).T_SubTID).T_MemF
Dim NPtr as TSNEX_Mem_Type Ptr
Dim XPos as UInteger
Do Until TPtr = 0
D += TPtr->V_Data
Do
XPos = InStr(1, D, Chr(10))
If XPos = 0 Then Exit Do
T = Left(D, XPos - 1)
D = Mid(D, XPos + 1)
If Right(T, 1) = Chr(13) Then T = Left(T, Len(T) - 1)
If T <> "" Then
If Left(T, 1) = "-" Then
R_FileC += 1
Redim Preserve R_FileD(R_FileC) as String
R_FileD(R_FileC) = Mid(T, 56)
Else
R_FolderC += 1
Redim Preserve R_FolderD(R_FolderC) as String
R_FolderD(R_FolderC) = Mid(T, 56)
End If
End If
Loop
NPtr = TPtr->V_Next
DeAllocate(TPtr)
TPtr = NPtr
Loop
If G_TSNEX_CD(XID).T_SubTID <> 0 Then G_TSNEX_CD(G_TSNEX_CD(XID).T_SubTID).V_InUse = 0
MutexUnLock(G_TSNEX_Mutex)
TSNE_Disconnect(XTSNEID)
Return TSNEX_Const_NoError
End Function
'--------------------------------------------------------------------------------------------------------------
Function TSNEX_FTP_Download(V_HostOrURL as String, V_Port as UShort = 0, V_Username as String = "anonymous", V_Password as String = "anynomous@ano.nym", V_PathFile as String = "", V_TargetPathFile as String = "", V_ProgressCallback as Any Ptr = 0) as Integer
Dim XURL as URL_Type
Dim XPos as UInteger
If URL_Split(V_HostOrURL, XURL) = 1 Then
With XURL
.V_Protocol = "ftp"
.V_Host = V_HostOrURL
.V_Port = V_Port
.V_Username = V_Username
.V_Password = V_Password
XPos = InStr(1, V_PathFile, "/"): If XPos = 0 Then XPos = InStr(1, V_PathFile, "\")
If XPos = 0 Then Return TSNEX_Const_PathFileError
.V_Path = Left(V_PathFile, XPos - 1)
.V_File = Mid(V_PathFile, XPos + 1)
XPos = InStr(1, .V_File, ".")
If XPos > 0 Then
.V_FileType = Mid(.V_File, XPos + 1)
.V_File = Left(.V_File, XPos - 1)
End If
End With
End If
Dim TTarget as String
With XURL
If LCase(.V_Protocol) <> "ftp" Then Return TSNEX_Const_ProtocolNotSupported
If .V_Port = 0 Then .V_Port = 21
If (.V_Host = "") or (.V_Port = 0) or (.V_Username = "") or (.V_Password = "") Then Return TSNEX_Const_URLorHostDataMissing
If .V_Path = "" Then Return TSNEX_Const_PathFileError
If Right(.V_Path, 1) = "\" Then Return TSNEX_Const_PathFileError
TTarget = V_TargetPathFile
If (Right(TTarget, 1) = "*") Then Return TSNEX_Const_PathFileError
If (Right(TTarget, 1) = "/") or (Right(TTarget, 1) = "\") Then
TTarget += .V_File
If .V_FileType <> "" Then TTarget += "." & .V_FileType
End If
If TTarget = "" Then
TTarget = .V_File
If .V_FileType <> "" Then TTarget += "." & .V_FileType
End if
If (Right(TTarget, 1) = "/") or (Right(TTarget, 1) = "\") or (Right(TTarget, 1) = "*") Then Return TSNEX_Const_PathFileError
XPos = InStrRev(TTarget, "/"): If XPos = 0 Then XPos = InStrRev(TTarget, "\")
If XPos > 0 Then If Dir(Left(TTarget, XPos) & "*", -1) = "" Then Return TSNEX_Const_TargetPathNotFound
If Dir(TTarget, -1) <> "" Then Return TSNEX_Const_TargetAlreadyExist
MutexLock(G_TSNEX_Mutex)
Dim XTSNEID as UInteger
Dim RV as Integer = TSNE_Create_Client(XTSNEID, .V_Host, .V_Port, @TSNEX_Disconnected, @TSNEX_Connected, @TSNEX_NewData)
If RV <> TSNE_Const_NoError Then MutexUnLock(G_TSNEX_Mutex): Return RV
End With
Dim XID as UInteger
For X as UInteger = 1 to G_TSNEX_CC
If G_TSNEX_CD(X).V_InUse = 0 Then XID = X: Exit For
Next
If XID = 0 Then
G_TSNEX_CC += 1
XID = G_TSNEX_CC
Redim Preserve G_TSNEX_CD(G_TSNEX_CC) as TSNEX_Con_Type
End If
Dim TCC as TSNEX_Con_Type
G_TSNEX_CD(XID) = TCC
With G_TSNEX_CD(XID)
.V_InUse = 1
.V_TSNEID = XTSNEID
.V_State = TSNEX_SE_Init
.V_URLType = XURL
.V_Target = TTarget
.V_Type = TSNEX_CE_FTP
.V_CMD = TSNEX_ME_FTP_Download
.T_CallBack = V_ProgressCallback
End With
MutexUnLock(G_TSNEX_Mutex)
RV = TSNEX_WaitState(XID, TSNEX_SE_Ready): If RV <> TSNEX_Const_NoError Then MutexLock(G_TSNEX_Mutex): If G_TSNEX_CD(XID).V_TSNEID = XTSNEID Then G_TSNEX_CD(XID) = TCC: MutexUnLock(G_TSNEX_Mutex): Return RV
TSNE_Disconnect(XTSNEID)
Return TSNEX_Const_NoError
End Function
'--------------------------------------------------------------------------------------------------------------
Function TSNEX_FTP_Upload(V_HostOrURL as String, V_Port as UShort = 0, V_Username as String = "anonymous", V_Password as String = "anynomous@ano.nym", V_PathFile as String = "", V_SourcePathFile as String = "", V_ProgressCallback as Any Ptr = 0) as Integer
If V_SourcePathFile = "" Then Return TSNEX_Const_TargetPathNotFound
If Right(V_SourcePathFile, 1) = "*" Then Return TSNEX_Const_TargetPathNotFound
If Right(V_SourcePathFile, 1) = "/" Then Return TSNEX_Const_TargetPathNotFound
If Right(V_SourcePathFile, 1) = "\" Then Return TSNEX_Const_TargetPathNotFound
Dim XURL as URL_Type
Dim XPos as UInteger
If URL_Split(V_HostOrURL, XURL) = 1 Then
With XURL
.V_Protocol = "ftp"
.V_Host = V_HostOrURL
.V_Port = V_Port
.V_Username = V_Username
.V_Password = V_Password
XPos = InStr(1, V_PathFile, "/"): If XPos = 0 Then XPos = InStr(1, V_PathFile, "\")
If XPos = 0 Then Return TSNEX_Const_PathFileError
.V_Path = Left(V_PathFile, XPos - 1)
.V_File = Mid(V_PathFile, XPos + 1)
XPos = InStr(1, .V_File, ".")
If XPos > 0 Then
.V_FileType = Mid(.V_File, XPos + 1)
.V_File = Left(.V_File, XPos - 1)
End If
End With
End If
With XURL
If LCase(.V_Protocol) <> "ftp" Then Return TSNEX_Const_ProtocolNotSupported
If .V_Port = 0 Then .V_Port = 21
If (.V_Host = "") or (.V_Port = 0) or (.V_Username = "") or (.V_Password = "") Then Return TSNEX_Const_URLorHostDataMissing
If .V_Path = "" Then Return TSNEX_Const_PathFileError
If (.V_File = "") and (.V_FileType = "") Then
XPos = InStrRev(V_SourcePathFile, "/"): If XPos = 0 Then XPos = InStrRev(V_SourcePathFile, "\")
If XPos > 0 Then
.V_File = Mid(V_SourcePathFile, XPos + 1)
Else: .V_File = V_SourcePathFile
End If
XPos = InStrRev(V_SourcePathFile, ".")
If XPos > 0 Then
.V_FileType = Mid(.V_File, XPos + 1)
.V_File = Left(.V_File, XPos - 1)
End If
End If
MutexLock(G_TSNEX_Mutex)
Dim XTSNEID as UInteger
Dim RV as Integer = TSNE_Create_Client(XTSNEID, .V_Host, .V_Port, @TSNEX_Disconnected, @TSNEX_Connected, @TSNEX_NewData)
If RV <> TSNE_Const_NoError Then MutexUnLock(G_TSNEX_Mutex): Return RV
End With
Dim XID as UInteger
For X as UInteger = 1 to G_TSNEX_CC
If G_TSNEX_CD(X).V_InUse = 0 Then XID = X: Exit For
Next
If XID = 0 Then
G_TSNEX_CC += 1
XID = G_TSNEX_CC
Redim Preserve G_TSNEX_CD(G_TSNEX_CC) as TSNEX_Con_Type
End If
Dim TCC as TSNEX_Con_Type
G_TSNEX_CD(XID) = TCC
With G_TSNEX_CD(XID)
.V_InUse = 1
.V_TSNEID = XTSNEID
.V_State = TSNEX_SE_Init
.V_URLType = XURL
.V_Target = V_SourcePathFile
.V_Type = TSNEX_CE_FTP
.V_CMD = TSNEX_ME_FTP_UpLoad
.T_CallBack = V_ProgressCallback
End With
MutexUnLock(G_TSNEX_Mutex)
RV = TSNEX_WaitState(XID, TSNEX_SE_Ready): If RV <> TSNEX_Const_NoError Then MutexLock(G_TSNEX_Mutex): If G_TSNEX_CD(XID).V_TSNEID = XTSNEID Then G_TSNEX_CD(XID) = TCC: MutexUnLock(G_TSNEX_Mutex): Return RV
TSNE_Disconnect(XTSNEID)
Return TSNEX_Const_NoError
End Function
'--------------------------------------------------------------------------------------------------------------
Function TSNEX_FTP_Delete(V_HostOrURL as String, V_Port as UShort = 0, V_Username as String = "anonymous", V_Password as String = "anynomous@ano.nym", V_PathFile as String = "") as Integer
Dim XURL as URL_Type
Dim XPos as UInteger
If URL_Split(V_HostOrURL, XURL) = 1 Then
With XURL
.V_Protocol = "ftp"
.V_Host = V_HostOrURL
.V_Port = V_Port
.V_Username = V_Username
.V_Password = V_Password
XPos = InStr(1, V_PathFile, "/"): If XPos = 0 Then XPos = InStr(1, V_PathFile, "\")
If XPos = 0 Then Return TSNEX_Const_PathFileError
.V_Path = Left(V_PathFile, XPos - 1)
.V_File = Mid(V_PathFile, XPos + 1)
XPos = InStr(1, .V_File, ".")
If XPos > 0 Then
.V_FileType = Mid(.V_File, XPos + 1)
.V_File = Left(.V_File, XPos - 1)
End If
End With
End If
With XURL
If LCase(.V_Protocol) <> "ftp" Then Return TSNEX_Const_ProtocolNotSupported
If .V_Port = 0 Then .V_Port = 21
If (.V_Host = "") or (.V_Port = 0) or (.V_Username = "") or (.V_Password = "") Then Return TSNEX_Const_URLorHostDataMissing
If .V_Path = "" Then Return TSNEX_Const_PathFileError
If Right(.V_Path, 1) = "\" Then Return TSNEX_Const_PathFileError
If (.V_File = "") and (.V_FileType = "") Then Return TSNEX_Const_PathFileError
MutexLock(G_TSNEX_Mutex)
Dim XTSNEID as UInteger
Dim RV as Integer = TSNE_Create_Client(XTSNEID, .V_Host, .V_Port, @TSNEX_Disconnected, @TSNEX_Connected, @TSNEX_NewData)
If RV <> TSNE_Const_NoError Then MutexUnLock(G_TSNEX_Mutex): Return RV
End With
Dim XID as UInteger
For X as UInteger = 1 to G_TSNEX_CC
If G_TSNEX_CD(X).V_InUse = 0 Then XID = X: Exit For
Next
If XID = 0 Then
G_TSNEX_CC += 1
XID = G_TSNEX_CC
Redim Preserve G_TSNEX_CD(G_TSNEX_CC) as TSNEX_Con_Type
End If
Dim TCC as TSNEX_Con_Type
G_TSNEX_CD(XID) = TCC
With G_TSNEX_CD(XID)
.V_InUse = 1
.V_TSNEID = XTSNEID
.V_State = TSNEX_SE_Init
.V_URLType = XURL
.V_Type = TSNEX_CE_FTP
.V_CMD = TSNEX_ME_FTP_Delete
End With
MutexUnLock(G_TSNEX_Mutex)
RV = TSNEX_WaitState(XID, TSNEX_SE_Ready): If RV <> TSNEX_Const_NoError Then MutexLock(G_TSNEX_Mutex): If G_TSNEX_CD(XID).V_TSNEID = XTSNEID Then G_TSNEX_CD(XID) = TCC: MutexUnLock(G_TSNEX_Mutex): Return RV
TSNE_Disconnect(XTSNEID)
Return TSNEX_Const_NoError
End Function
'##############################################################################################################
Function TSNEX_SMTP_SendMail(V_RelayServer as String, V_RelayPort as UShort = 0, V_Username as String = "", V_Password as String = "", V_FromMailAdr as String, V_ToMailAdr as String, V_Subject as String, V_Message as String) as Integer
If V_FromMailAdr = "" Then Return TSNEX_Const_MissingParameter
If V_ToMailAdr = "" Then Return TSNEX_Const_MissingParameter
If V_Subject = "" Then Return TSNEX_Const_MissingParameter
If V_Message = "" Then Return TSNEX_Const_MissingParameter
Dim XPos as UInteger
XPos = InStr(1, V_FromMailAdr, "@"): If XPos = 0 Then Return TSNEX_Const_EMailSyntaxError
XPos = InStr(1, Mid(V_FromMailAdr, XPos + 1), "."): If XPos = 0 Then Return TSNEX_Const_EMailSyntaxError
XPos = InStr(1, V_ToMailAdr, "@"): If XPos = 0 Then Return TSNEX_Const_EMailSyntaxError
XPos = InStr(1, Mid(V_ToMailAdr, XPos + 1), "."): If XPos = 0 Then Return TSNEX_Const_EMailSyntaxError
Dim XURL as URL_Type
Dim T as String
If V_RelayServer <> "" Then
If URL_Split(V_RelayServer, XURL) = 1 Then
With XURL
.V_Protocol = "smtp"
.V_Host = V_RelayServer
.V_Port = V_RelayPort
.V_Username = V_Username
.V_Password = V_Password
End With
End If
Else
XPos = InStr(1, V_ToMailAdr, "@"): If XPos = 0 Then Return TSNEX_Const_EMailSyntaxError
With XURL
.V_Protocol = "smtp"
.V_Host = Mid(V_ToMailAdr, XPos + 1)
.V_Port = V_RelayPort
.V_Username = V_Username
.V_Password = V_Password
End With
End If
With XURL
If LCase(.V_Protocol) <> "smtp" Then Return TSNEX_Const_ProtocolNotSupported
If .V_Port = 0 Then .V_Port = 25
If (.V_Host = "") or (.V_Port = 0) Then Return TSNEX_Const_URLorHostDataMissing
MutexLock(G_TSNEX_Mutex)
Dim XTSNEID as UInteger
Dim RV as Integer = TSNE_Create_Client(XTSNEID, .V_Host, .V_Port, @TSNEX_Disconnected, @TSNEX_Connected, @TSNEX_NewData)
If RV <> TSNE_Const_NoError Then MutexUnLock(G_TSNEX_Mutex): Return RV
End With
Dim XID as UInteger
For X as UInteger = 1 to G_TSNEX_CC
If G_TSNEX_CD(X).V_InUse = 0 Then XID = X: Exit For
Next
If XID = 0 Then
G_TSNEX_CC += 1
XID = G_TSNEX_CC
Redim Preserve G_TSNEX_CD(G_TSNEX_CC) as TSNEX_Con_Type
End If
Dim TCC as TSNEX_Con_Type
G_TSNEX_CD(XID) = TCC
With G_TSNEX_CD(XID)
.V_InUse = 1
.V_TSNEID = XTSNEID
.V_State = TSNEX_SE_Init
.V_URLType = XURL
.V_Type = TSNEX_CE_SMTP
.V_CMD = TSNEX_ME_SMTP_Send
.V_Data(1) = V_FromMailAdr
.V_Data(2) = V_ToMailAdr
.V_Data(3) = V_Subject
.V_Data(4) = V_Message
End With
MutexUnLock(G_TSNEX_Mutex)
RV = TSNEX_WaitState(XID, TSNEX_SE_Ready): If RV <> TSNEX_Const_NoError Then MutexLock(G_TSNEX_Mutex): If G_TSNEX_CD(XID).V_TSNEID = XTSNEID Then G_TSNEX_CD(XID) = TCC: MutexUnLock(G_TSNEX_Mutex): Return RV
Return TSNEX_Const_NoError
End Function
'##############################################################################################################
'...<
#ENDIF