WebRemote - programme mittels Browser starten

Anwendungen, Tools, Userlibs und anderes nützliches.
GPI
Beiträge: 1511
Registriert: 29.08.2004 13:18
Kontaktdaten:

WebRemote - programme mittels Browser starten

Beitrag von GPI »

Das Programm basiert unter anderen auf den Atomic-Web-Server-Beispiel von PureBasic.

Das Ding fährt eine Art Webserver hoch stellt quasi eine "Linkleiste" zur Verfügung. GEdacht ist das so: Auf einen anderen Server Ruf ich diese Webseite auf,klick auf ein Programm und auf den Entfernten Rechner wird das gewünschte Programm gestartet.

Der Webserver ist ziemlich blöd. Außer die Auswahlseite, den Link-Bildern und den Links zum starten versendet das Teil nichts.

Zum anwenden: Einfach das Programm in einen Verzeichnis kopieren, dann die Links in das gleiche Verzeichnis kopieren.
Wenn man ein Link mit auf "C:\windows\system32\Shutdown /s /t 00" in das Verzeichnis von WebRemote erstellt, kann man den Rechner mit jeden Gerät, das einen Webbrowser darstellen kann, beenden.

Das Programm kann mit zwei Parametern gefüttert werden (müssen in der Reihenfolge kommen): "<port> hidden" - port gibt eine Portnummer an. Standardmäßig wird 8080 genommen. Hidden ist optional (wenn benötigt muss eine Portnummer angegeben werden!) - es versteckt das Fenster von Webremote, standarmäßig ists sichtbar.

hier der code

Code: Alles auswählen

#c34=Chr(34)

Procedure.s GetLinkIcon(ShellLink.s, *nr)
  ;LinkFile.s=Str(Len(ShellLink)*2)
  ;MultiByteToWideChar_(#CP_ACP, 0, ShellLink, -1, @LinkFile, Len(ShellLink)) ;We need a WideChar version of the ShellLink.s
  
  Buf.s = Space(1024)
  Hotkey.w = 0
  
  Result = 0
  CoInitialize_(0)
  If CoCreateInstance_(?CLSID_ShellLink,0,1,?IID_IShellLink,@psl.IShellLinkA) >= 0
    If psl\QueryInterface(?IID_IPersistFile, @ppf.IPersistFile) >= 0
      If ppf\Load(shelllink,0) >= 0 ;Icon loaded?
        ;Get the icon file and the icon index
        psl\GetIconLocation(@Buf, 1024, *nr)
        If buf=""
          psl\GetPath(Buf, 1024, 0, 4)
        EndIf
      EndIf
      ppf\Release()
    EndIf
    psl\Release()
  EndIf
  CoUninitialize_()
  
  
  
  ProcedureReturn buf
  
  
  
  DataSection
    CLSID_ShellLink:
    ; 00021401-0000-0000-C000-000000000046
    Data.l $00021401
    Data.w $0000,$0000
    Data.b $C0,$00,$00,$00,$00,$00,$00,$46
    IID_IShellLink:
    ; DEFINE_SHLGUID(IID_IShellLinkA,         0x000214EEL, 0, 0)
    ; C000-000000000046
    Data.l $000214EE
    Data.w $0000,$0000
    Data.b $C0,$00,$00,$00,$00,$00,$00,$46
    IID_IPersistFile:
    ; 0000010b-0000-0000-C000-000000000046
    Data.l $0000010b
    Data.w $0000,$0000
    Data.b $C0,$00,$00,$00,$00,$00,$00,$46
  EndDataSection
  
EndProcedure
Procedure.s DeEnviroment(a$)
  Repeat
    a1=FindString(a$,"%",0)
    a2=FindString(a$,"%",a1+1)
    If a1 And a2
      b$= Mid(a$,a1+1,a2-a1-1)
      
      b$=GetEnvironmentVariable(b$) 
      
      
      a$=Left(a$,a1-1)+b$+Mid(a$,a2+1)
    Else
      Break 
    EndIf
  ForEver
  ProcedureReturn a$
EndProcedure

Procedure LoadIcon(File$,b.l=0)
  ;file$=DeEnviroment(file$)
  If b=0
    ProcedureReturn ExtractAssociatedIcon_(GetModuleHandle_(0),file$,@b)
  Else  
    
    ProcedureReturn ExtractIcon_(GetModuleHandle_(0),file$,b)
  EndIf
EndProcedure  
Procedure FreeIcon(icon)
  If icon
    ProcedureReturn DestroyIcon_(Icon)
  EndIf
EndProcedure

Procedure GetIcon(File$)
  icon=0
  If UCase(GetExtensionPart(file$))="LNK" 
    icon$=GetLinkIcon(file$,@a.l)
    icon=loadicon(icon$,a)
  ElseIf UCase(GetExtensionPart(file$))="URL"
    icon$="":iconnr=0
    If ReadFile(1,file$)
      While Not Eof(1)
        a$=ReadString(1)
        Select UCase(StringField(a$,1,"="))
          Case "ICONFILE":icon$=StringField(a$,2,"=")
          Case "ICONINDEX":iconnr=Val(StringField(a$,2,"="))
        EndSelect
      Wend
      CloseFile(1)
    EndIf
    If icon$
      icon=loadicon(icon$,iconnr)
    Else
      icon=loadicon(file$)
    EndIf
  Else  
    icon=loadicon(file$)
  EndIf
  ProcedureReturn icon
EndProcedure
UsePNGImageEncoder()

Procedure GetLinkList(List links.s())
  ClearList(links())
  dir=ExamineDirectory(#PB_Any,".\","*.lnk")
  If dir
    While NextDirectoryEntry(dir)
      name$=DirectoryEntryName(dir)  
      If FileSize(name$+".png")<=0
        icon=geticon(name$)
        CreateImage(1,48,48,32|#PB_Image_Transparent )
        StartDrawing(ImageOutput(1))
        DrawImage(icon,0,0,48,48)
        StopDrawing()
        SaveImage(1,name$+".png",#PB_ImagePlugin_PNG)
        FreeImage(1)
        freeicon(icon)
      EndIf
      AddElement(links())
      links()=name$
    Wend
    FinishDirectory(dir)
  EndIf
EndProcedure

Procedure.s CreateDefaultPage(addtext$="",links=#True)
  b$="<html>"
  b$+"<head>"
  b$+"<title>"+GetEnvironmentVariable("COMPUTERNAME")+"</title>"
  b$+"</head>"
  b$+"<body>"
  
  b$+"<h1>"+GetEnvironmentVariable("COMPUTERNAME")+"</h1>"
  b$+addtext$
  
  If links
    NewList links.s()
    getlinklist(links())
    b$+"<div>"
    ForEach links()
      b$+"<div align="+#c34+"center"+#c34+" style="+#c34+"overflow:hidden;width:150px;height:80px;margin:5px;display:inline-block;"+#c34+"><a href="+#c34+URLEncoder(links())+#c34+">"
      b$+"<img src="+#c34+URLEncoder(links())+".png"+#c34+" align="+#c34+"middle"+#c34+" alt="+#c34+links()+#c34+" border="+#c34+"0"+#c34+">"  
      b$+"<br>"+Left(links(),Len(links())-4)+"</a></div>"
    Next
    b$+"</div><br><div>"
    b$+"<a href="+#c34+"endWebRemote.lnk"+#c34+">WebRemote beenden</a>"
    b$+"</div>"
  EndIf
  
  b$+"</body>"
  b$+"</html>"
  ProcedureReturn b$
EndProcedure

Declare BuildRequestHeader(*Buffer, DataLength.l, ContentType$)

Procedure SendFile(ClientID,File$,type$)
  file=ReadFile(#PB_Any,File$)
  If file
    flen=Lof(file)
    *FileBuffer   = AllocateMemory(flen+1024)
    *BufferOffset = BuildRequestHeader(*FileBuffer, flen, type$)
    ReadData(file,*BufferOffset,flen)              
    
    SendNetworkData(ClientID, *FileBuffer, *BufferOffset-*FileBuffer+flen)
    FreeMemory(*FileBuffer)
    CloseFile(file)
  EndIf
EndProcedure
Procedure SendMemory(ClientId,*buf,flen,type$)
  *FileBuffer   = AllocateMemory(flen+1024)
  *BufferOffset = BuildRequestHeader(*FileBuffer, flen, type$)
  CopyMemory(*buf,*BufferOffset,flen)              
  
  SendNetworkData(ClientID, *FileBuffer, *BufferOffset-*FileBuffer+flen)
  FreeMemory(*FileBuffer)
EndProcedure
Procedure SendString(ClientID,html$)
  SendMemory(ClientID,@html$,Len(html$),"text/html")
  
EndProcedure



If InitNetwork() = 0
  MessageRequester("Error", "Can't initialize the network !", 0)
  End
EndIf


port= Val(ProgramParameter()): 
If port=0 
  Port = 8080
EndIf

BaseDirectory$ = ""
DefaultIcon$="default.png"
AtomicTitle$   = "Atomic Web Server v1.0"

Global EOL$

EOL$ = Chr(13)+Chr(10)

*Buffer = AllocateMemory(10000)

If CreateNetworkServer(0, Port)
  If ProgramParameter()="hidden"
    
    OpenWindow(0, 100, 200, 230, 0, "Atomic Web Server (Port "+Str(Port)+")",#PB_Window_Invisible) 
  Else
    OpenWindow(0, 100, 200, 230, 0, "Atomic Web Server (Port "+Str(Port)+")")
  EndIf
  
  Repeat
    
    Repeat
      WEvent = WindowEvent()
      
      If WEvent = #PB_Event_CloseWindow : Quit = 1 : EndIf
    Until WEvent = 0
    
    SEvent = NetworkServerEvent()
    
    If SEvent
      ClientID.l = EventClient()
      
      Select SEvent
          
        Case 1  ; When a new client has been connected...
          
        Case 4  ; When a client has closed the connection...
          
        Default
          RequestLength.l = ReceiveNetworkData(ClientID, *Buffer, 2000)
          ProcessRequest:
          
          a$ = PeekS(*Buffer)
          
          If Left(a$, 3) = "GET"
            
            MaxPosition = FindString(a$, Chr(13), 5)
            Position = FindString(a$, " ", 5)
            If Position < MaxPosition
              RequestedFile$ = Mid(a$, 6, Position-5)      ; Automatically remove the leading '/'
              RequestedFile$ = RTrim(RequestedFile$)
            Else
              RequestedFile$ = Mid(a$, 6, MaxPosition-5)   ; When a command like 'GET /' is sent..
            EndIf
            
            
            If RequestedFile$ = ""
              html$=CreateDefaultPage()
              sendstring(ClientID,html$)
            Else
              *t.byte = @RequestedFile$
              While *t\b <> 0
                If *t\b = '/' : *t\b = '\' : EndIf
                *t+1
              Wend
              
              RequestedFile$=URLDecoder( GetFilePart(RequestedFile$))
              ;Debug RequestedFile$
              
              Select LCase(GetExtensionPart(RequestedFile$))
                Case "lnk"
                  ;RunProgram("start",RequestedFile$,".\")
                  If RequestedFile$="endWebRemote.lnk"
                    html$=CreateDefaultPage("WebRemote wird beendet...<br><br>",#False)
                    sendstring(ClientID,html$)
                    quit=1
                  Else
                    ShellExecute_(0,"",RequestedFile$,0,0,#SW_SHOW)
                    html$=CreateDefaultPage("Link "+RequestedFile$+" gestartet<br><a href="+#c34+"javascript:history.back()"+#c34+">zur&uuml;ck</a>",#False)
                    sendstring(ClientID,html$)
                  EndIf
                Case "png"
                  If FileSize(RequestedFile$)<=0
                    SendFile(ClientID,DefaultIcon$,"image/png")
                  Else
                    SendFile(clientID,RequestedFile$,"image/png")
                  EndIf
                Default
                  html$=CreateDefaultPage()
                  sendstring(ClientID,html$)
              EndSelect
              
            EndIf
            
          EndIf
          
          
      EndSelect
      
    Else
      Delay(20)  ; Don't stole the whole CPU !
    EndIf
    
  Until Quit = 1 
  
  CloseNetworkServer(0)
Else
  MessageRequester(AtomicTitle$, "Error: can't create the server (port in use ?).", 0)
EndIf

End 



Procedure BuildRequestHeader(*Buffer, DataLength.l, ContentType$)
  
  Length = PokeS(*Buffer, "HTTP/1.1 200 OK"+EOL$)                     : *Buffer+Length
  Length = PokeS(*Buffer, "Date: Wed, 07 Aug 2996 11:15:43 GMT"+EOL$) : *Buffer+Length
  Length = PokeS(*Buffer, "Server: Atomic Web Server 0.2b"+EOL$)      : *Buffer+Length
  Length = PokeS(*Buffer, "Content-Length: "+Str(DataLength)+EOL$)    : *Buffer+Length
  Length = PokeS(*Buffer, "Content-Type: "+ContentType$+EOL$)         : *Buffer+Length
  Length = PokeS(*Buffer, EOL$)                                       : *Buffer+Length
  
  ; Length = PokeS(*Buffer, "Last-modified: Thu, 27 Jun 1996 16:40:50 GMT"+Chr(13)+Chr(10)  , *Buffer) : *Buffer+Length
  ; Length = PokeS(*Buffer, "Accept-Ranges: bytes"+EOL$                 , *Buffer) : *Buffer+Length
  ; Length = PokeS(*Buffer, "Connection: close"+EOL$) : *Buffer+Length
  
  ProcedureReturn *Buffer
EndProcedure

Viel Spaß damit.

Edit: Bevor ich es vergesse: Das Teil sollte *AUF* *KEINEN* *FALL* einfach ins Internet geroutet werden! Ich nutz bei mir für sowas eine VPN-Verbinung meiner Fritzbox - wenn mein kleiner Laptop mal von extern auf den Rechner zugreifen muss. Ich hab bspw. neben den Shutdown-Link und Links zu UltraVNC und OpenSSH reingelegt, so das die beiden Programme nicht dauernt laufen müssen. Den Hauptrechner kann ich übrigens bequem über Wake-On-Lan über die Fritzbox starten. Sollte ich also mal von irgendwoher auf meinen PC zugreifen muss, kann ich meinen Laptop über VPN ist lokale Netzwerk einlinken und per Fritzbox den PC starten. ANschließen kann ich mittels Dateifreigaben zugreifen und WebRemote den REchner wieder runterfahren :)
CodeArchiv Rebirth: Deutsches Forum Github Hilfe ist immer gern gesehen!