webserver_plugin.pas

国外的远程控制源码,国内首发~~~我看到了就转过来了~

{Webserver LITE 1.0

 Version : 1.0
 Written By : ~LOM~
 Website : www.evileyesoftware.com

 OverView
 --------

 This is a basic webserver i did for learning sake -
 really wasn't that hard - ive commented the most part ;)
 if you use any of the source please credit ~LOM~ and
 evileyesoftware.com

 Ive kept everything pretty lite - using basic API ;) }

unit webserver_plugin;

interface

uses Windows, Sockets;

Const
  CRLF = #13#10;
  PACKETLEN = 5012;
  DOT = '.';

type
  TWebserverInfo = packed record
    Port: String;
    Directory: String;
    Connection: TClientSocket;
  end;

var
  WebServer: TServerSocket;
  SInfo: TWebserverInfo;
  CloseServer: Boolean = False;

procedure StartWebServer(Port, Directory: String);

implementation

function ExtractFileExt(Delimiter, Input: String): String;
begin
  While Pos(Delimiter, Input) <> 0 do
    Delete(Input, 1, Pos(Delimiter, Input));

  Result := Input;
end;

function LowerCase(const S: string): string;
var
  Ch: Char;
  L: Integer;
  Source, Dest: PChar;
begin
  L := Length(S);
  SetLength(Result, L);
  Source := Pointer(S);
  Dest := Pointer(Result);
  while L <> 0 do
  begin
    Ch := Source^;
    if (Ch >= 'A') and (Ch <= 'Z') then
      Inc(Ch, 32);
    Dest^ := Ch;
    Inc(Source);
    Inc(Dest);
    Dec(L);
  end;
end;

procedure ServeFile(Filename: String; Connection: TClientSocket);
var
  FileHandle: Cardinal;
  BytesRead: Cardinal;
  FileBuffer: array[0..PACKETLEN] of Char;

  FileStream: String;
  FileSize: Integer;

  ContentType: String;
  Result, ResultOut: String;
begin
  ContentType := '';
  Result := '';
  ResultOut := '';

  //remove any subdirectories
  Filename := ExtractFileExt('/', Filename);

  //Test if any file has been given, if not then use parent
  If Filename = '' then
    Filename := 'index.htm';

  Writeln('Serving File : ' + SInfo.Directory + '/' + Filename);

  //Open the file for reading
  FileHandle := CreateFile(Pchar(SInfo.Directory + '/' + Filename), LongWord($80000000), 0, nil, 3, $00000080, 0);
  //get the filesize of the file in question
  FileSize := GetFileSize(FileHandle, nil);

  //List of Accepted file types
  If (ExtractFileExt(DOT, Filename) = 'htm') or (ExtractFileExt(DOT, Filename) = 'html') then ContentType := 'text/html';
  If (ExtractFileExt(DOT, Filename) = 'jpg') or (ExtractFileExt(DOT, Filename) = 'jpeg') then ContentType := 'image/jpeg';
  If ExtractFileExt(DOT, Filename) = 'gif'   then ContentType := 'image/gif';
  If ExtractFileExt(DOT, Filename) = 'png'   then ContentType := 'image/png';

  If ExtractFileExt(DOT, Filename) = 'zip' then ContentType := 'application/zip';
  If ExtractFileExt(DOT, Filename) = 'exe' then ContentType := 'application/octet-stream';

  If ContentType = '' then ContentType := 'text/html';

  //Create the resulting feed loop
  Result := 'HTTP/1.1 200 OK' + CRLF
            + 'Accept-Ranges: bytes' + CRLF
            + 'Content-Length: ' + IntToStr(FileSize) + CRLF
            + 'Keep-Alive: timeout=15, max=100' + CRLF
            + 'Connection: Keep-Alive' + CRLF
            + 'Content-Type: ' + ContentType + CRLF + CRLF;

  //set the length of for sending the information
  SetLength(ResultOut, Length(Result));
  //move it to the lengthed string
  ResultOut := Result;
  //0 the original (save mem)
  Result := '';

  //set the string length for file reading
  SetLength(FileStream, PACKETLEN);
  //Write the initial loop feed
  Connection.Write(ResultOut[1], Length(ResultOut));

  //loop through the file bit by bit, sending the packets
  Repeat
    ReadFile(FileHandle, FileStream[1], PACKETLEN, BytesRead, nil);
    Connection.Write(FileStream[1], PACKETLEN);
  Until BytesRead < PACKETLEN;

  //close the file in question
  CloseHandle(FileHandle);
end;

procedure ServePages(Params: Pointer); StdCall;
var
  BufferIn, BufferOut, BufferTemp, FileToServe, StrmContents: String;
  Len: Integer;
begin
  If TWebserverInfo(Params^).Connection.WaitForData then
  begin
    BufferIn := '';
    FileToServe := '';

    SetLength(BufferIn, PACKETLEN);
    Len := TWebserverInfo(Params^).Connection.read(BufferIn[1], PACKETLEN);

    //If Len = 65535 then Break;
    BufferIn := Copy(BufferIn, 1, Len);

    //test to see if the command is trying to retrieve information
    If Pos('GET', BufferIn) > 0 then
    begin
      //remove the 'GET '
      Delete(BufferIn, 1, 4);
      //Get the file the browser has requested
      FileToServe := Copy(BufferIn, 1, Pos('HTTP/1.1', BufferIn)-2);
      //Send the file procedure
      ServeFile(LowerCase(FileToServe), TWebserverInfo(Params^).Connection);
    end;
  end;

  //Disconnect and destroy the connection from memory
  Writeln('Connection Disconnected : ' + TWebserverInfo(Params^).Connection.peerip);
  TWebserverInfo(Params^).Connection.Destroy;
end;

procedure ListenThread; StdCall;
var
  CInfo: array of TWebServerInfo;
  Client: array of TClientSocket;
  CCount: Integer;

  th1: Cardinal;
begin
  CCount := 0;
  
  WebServer := TServerSocket.Create(SInfo.Port);
  WebServer.Listen;

  While WebServer.WaitForConnection do
  begin
    If CloseServer then Break;

    SetLength(CInfo, CCount + 1);
    SetLength(Client, CCount + 1);

    Client[CCount] := TClientSocket.Create;

    WebServer.AcceptConnection(Client[CCount]);
    CInfo[CCount].Connection := Client[CCount];

    Writeln('Connection Established : ' + Client[CCount].peerIP);

    //Start Thread
    CreateThread(nil, 0, @ServePages, @Cinfo[CCount], 0, th1);
    Inc(CCount);
  end;

  WebServer.Destroy;
end;

procedure StartWebServer(Port, Directory: String);
begin
  Writeln('Port Opened : ' + Port);
  Writeln('Directory Serving From : ' + Directory);
  Writeln('');

  CloseServer := False;
  SInfo.Port := Port;
  SInfo.Directory := Directory;

  Writeln('Awaiting Connection');

  ListenThread;
end;

procedure StopWebServer;
begin
  CloseServer := True;
end;

end.