Scenix Lib IO OSI3 Tcpip Isxsupportfiles E2FILESOURCE Main.pas

unit  Main;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, CommObjs, CommInt, ComCtrls;

const
  ServerName = 'SX Web Server';

type
  TFileAllocationStructure = packed array[0..255] of word;

  TFileRecord = class
  private
    FSourceName : string;
    FDestinName : string;
    FTypeStr    : string;
    FReference  : byte;
    function    Back2FowardSlash(Str: string): string;
    function    Filename2Reference(Str: string): byte;
    function    FileChecksum(Stream: TStream): word;
  public
    constructor Create(Filename, SourcePath, DestinPath: string);
    function    AddToData(Data: TMemoryStream): boolean;
    property    SourceName: string read FSourceName;
    property    DestinName: string read FDestinName;
    property    TypeStr: string read FTypeStr;
    property    Reference: byte read FReference;
  end;

  TMainForm = class(TForm)
    DisplayList: TListBox;
    Button1: TButton;
    Button2: TButton;
    Button3: TButton;
    ComLink: TComm;
    ProgressBar: TProgressBar;
    Root: TEdit;
    Port: TComboBox;
    procedure Button1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
  private
    { Private declarations }
    FileList : TList;
    FileData : TMemoryStream;
    procedure AddDir(SourceDir, DestinDir: string);
    procedure ClearFilelist;
  public
    { Public declarations }
  end;

var
  MainForm: TMainForm;
  Position404 : integer;

implementation

{$R *.DFM}

const
  CrLf = #$0D + #$0A;

constructor TFileRecord.Create(Filename, SourcePath, DestinPath: string);
var
  Ext : string;
begin
  inherited Create;
  FSourceName := SourcePath + Filename;
  FDestinName := Back2FowardSlash(DestinPath + Filename);
  FReference  := Filename2Reference(FDestinName);
  FTypeStr    := 'unknown';
  Ext := LowerCase(ExtractFileExt(SourceName));
  if Ext = '.gif'  then FTypeStr := 'image/gif';
  if Ext = '.htm'  then FTypeStr := 'text/html';
  if Ext = '.html' then FTypeStr := 'text/html';
end;

function SwapWord(Data: word): word;
begin
  Result := ((Data shr 8) and $FF) + ((Data shl 8) and $FF00);
end;

function TFileRecord.AddToData(Data: TMemoryStream): boolean;
var
  FileStream : TFileStream;
  DataStream : TMemoryStream;
  HeaderStr  : string;
  DataSize   : word;
  Checksum   : word;
begin
  Result := false;
  if (Data <> nil) then
  begin
    FileStream := TFileStream.Create(FSourceName, fmOpenRead or fmShareDenyNone);
    if FileStream <> nil then
    begin
      //Create http header
      HeaderStr := 'HTTP/1.1 200 OK' + CrLf
                 + 'Content-Length: ' + IntToStr(FileStream.Size) + CrLf
                 + 'Server: ' + ServerName + CrLf
                 + 'Content-Type: ' + FTypeStr + CrLf
                 + 'Connection: close' + CrLf
                 + CrLf;
      //Create data
      DataStream := TMemoryStream.Create;
      DataSize := length(HeaderStr) + FileStream.Size;


      //if DataSize and 1 = 1 then DataSize := DataSize + 1;


      DataStream.Size := DataSize;
      //Copy http header
      DataStream.Write(HeaderStr[1], length(HeaderStr));
      //Copy file data
      DataStream.CopyFrom(FileStream, FileStream.Size);
      //Store data
      TFileAllocationStructure(Data.Memory^)[FReference] := SwapWord(Data.Position);
      if ExtractFileName(FSourceName) = '404.html' then
        Position404 := Data.Position;
      DataSize := SwapWord(DataStream.Size);
      if FTypeStr = 'text/html' then
        Checksum := 1
      else
        Checksum := 0;
      //Checksum := SwapWord(FileChecksum(DataStream));
      Checksum := SwapWord( Checksum );
      Data.Write(DataSize, 2);
      Data.Write(Checksum, 2);
      Data.CopyFrom(DataStream, 0);
      //Complete
      Result := true;
      DataStream.Free;
      FileStream.Free;
    end;
  end;
end;

function TFileRecord.Back2FowardSlash(Str: string): string;
var
  i : integer;
begin
  Result := '';
  if length(Str) > 0 then
  begin
    for i := 1 to length(Str) do
    begin
      if Str[i] = '\'
      then Result := Result + '/'
      else Result := Result + Str[i];
    end;
  end;
end;

function TFileRecord.Filename2Reference(Str: string): byte;
var
  i : integer;
begin
  Result := 0;
  if length(Str) > 0 then
  begin
    for i := 1 to length(Str)
    do Result := Result + byte(Str[i]);
  end;
  Result := Result and $FF;
end;

function TFileRecord.FileChecksum(Stream: TStream): word;
var
  Data     : word;
  Checksum : longint;
begin
  Checksum := 0;
  if Stream <> nil then
  begin
    Stream.Position :=0;
    while Stream.Position < Stream.Size do
    begin
      Stream.Read(Data, 2);
      Checksum := Checksum + SwapWord(Data);
      if Checksum > 65535 then CheckSum := (CheckSum and $FFFF) + 1;
    end;
    Stream.Position :=0;
  end;
  Result := Checksum and $FFFF;
end;

procedure TMainForm.FormCreate(Sender: TObject);
begin
  FileList := TList.Create;
  FileData := nil;
end;

procedure TMainForm.FormDestroy(Sender: TObject);
begin
  if FileData <> nil then FileData.Free;
  ClearFileList;
  FileList.Free;
end;

procedure TMainForm.AddDir(SourceDir, DestinDir: string);
var
  SearchRec  : TSearchRec;
  FileRecord : TFileRecord;
begin
  SourceDir := SourceDir + '\';
  DestinDir := DestinDir + '\';
  if FindFirst(SourceDir + '*.*', faAnyFile, SearchRec) = 0 then
  repeat
    if (SearchRec.Attr and faDirectory) > 0 then
    begin
      if SearchRec.Name[1] <> '.'
      then AddDir(SourceDir + SearchRec.Name, DestinDir + SearchRec.Name)
    end
    else
    begin
      FileRecord := TFileRecord.Create(SearchRec.Name, SourceDir, DestinDir);
      FileList.Add(FileRecord);
    end;
  until FindNext(SearchRec) <> 0;
end;

procedure TMainForm.ClearFileList;
var
  i : integer;
begin
  if FileList.Count > 0 then
  begin
    for i := 0 to FileList.Count - 1
    do TObject(FileList.Items[i]).Free;
    FileList.Clear;
  end;
end;

procedure TMainForm.Button1Click(Sender: TObject);
var
  SourceDir : string;
  i         : integer;
begin
  SourceDir := Root.Text;
  //Build file list
  ClearFileList;
  DisplayList.Items.Clear;
  if SourceDir <> ''
  then AddDir(SourceDir, '');
  if FileList.Count > 0 then
  begin
    for i := 0 to FileList.Count-1 do
      with TFileRecord(FileList.Items[i])
      do DisplayList.Items.Add(IntToHex(Reference, 2) + ':' + DestinName);
  end;
end;

procedure TMainForm.Button2Click(Sender: TObject);
var
  i : integer;
begin
  FileData.Free;
  FileData := nil;
  if FileList.Count > 0 then
  begin
    FileData := TMemoryStream.Create;
    FileData.Size := 65536;
    FillChar(FileData.Memory^, FileData.Size, 0);
    FileData.Position := SizeOf(TFileAllocationStructure);
    for i := 0 to FileList.Count - 1 do
    begin
      TFileRecord(FileList.Items[i]).AddToData(FileData);
    end;
    FileData.Size := FileData.Position;
    for i := 0 to 255 do
      if TFileAllocationStructure(FileData.Memory^)[i] = 0 then
        TFileAllocationStructure(FileData.Memory^)[i] := SwapWord(Position404);
  end;
end;

procedure TMainForm.Button3Click(Sender: TObject);
var
  Command  : byte;
  Reply    : byte;
  Size     : longint;
  Address  : longint;
  Data     : array[0..31] of byte;
  i        : integer;
begin
  if FileData = nil
  then MessageDlg('Error: Must build file data', mtError, [mbOk], 0)
  else
  begin
    FileData.SaveToFile('Test.dat');
    ComLink.DeviceName := Port.Text;
    ComLink.Open;
    Command := byte('?');
    ComLink.Write(Command, 1);
    Sleep(100);
    if (ComLink.Read(Reply, 1) <> 1) or (Reply <> byte('#'))
    then MessageDlg('Error: Unable to find SX on ' + ComLink.DeviceName, mtError, [mbOk], 0)
    else
    begin
      if ComLink.Read(Reply, 1) = 1
      then Size := Reply * 256
      else Size := 0;
      MessageDlg('Found SX with ' + IntToStr(Size) + ' byte EEPROM', mtInformation, [mbOk], 0);
      Screen.Cursor := crHourglass;
      ProgressBar.Position := 0;
      ProgressBar.Max := Size div 32;
      FileData.Position := 0;
      for i := 0 to (Size div 32) - 1 do
      begin
        Command := byte('W');
        ComLink.Write(Command, 1); //Command = write block
        Address := i * 32;
        Command := Address shr 8;
        ComLink.Write(Command, 1); //Address H
        ComLink.Write(Address, 1); //Address L
        FillChar(Data, 32, 0);
        FileData.Read(Data, 32);
        ComLink.Write(Data, 32);
        Sleep(20);                 //35 bytes @ 57600 = 6ms, E2 write time = 10ms, Also allow for windows overhead
        ProgressBar.StepIt;
        Application.ProcessMessages;
        if Application.Terminated then break;
      end;
      ProgressBar.Position := ProgressBar.Max;
      Screen.Cursor := crDefault;
      if not Application.Terminated
      then MessageDlg('Download complete', mtInformation, [mbOk], 0);
      ProgressBar.Position := 0;
    end;
    ComLink.Close;
  end;
end;

end.