HPSHELL

Contents of this page

• Parts of EDITORS.PAS, Syntaxhighlighting, HP Displays
• HPTRANS.PAS, File and Datatransfer
• HPDIR.PAS, Create HP48 Directory Variables from DOS Directories

{************************************************}
{                                                }
{   UNIT EDITORS                                 }
{   Copyright (c) 1992 Borland International     }
{   Copyright (c) 1993-98 by Tom Wellige         }
{                                                }
{   Part of HPShell                              }
{   Integrated Developing Environment            }
{   for HP48 calculators                         }
{                                                }
{   Author: Tom Wellige                          }
{   E-Mail: wellige@t-online.de                  }
{                                                }
{   These sources can be freely used as long     }
{   as their origin is stated in the             }
{   resulting program (code *and* exe)           }
{                                                }
{************************************************}

unit Editors;


[...]


procedure TEditor.ConvertText;
type
  sw = record s1, s2: word; end;
var
  Dlg : PDialog;
  R : TRect;
  P: PParser;
  Control, HScroll : PView;
  I: Word;
  Switch: sw;
  s1, s2: string;
  Pos: word;
begin
  Switch.s1:= $00; Switch.s2:= $00;

  R.Assign(0,0,47,17);
  New(Dlg, Init(R, GetString(436))); {'Text konvertieren'}

  with Dlg^ do
  begin
    Options:= Options or ofCentered;
    HelpCtx:= 41104;

    R.Assign(5, 1, 42, 12);
    Insert(New(P3D_Frame, Init(R)));

    R.Assign(13,3,34,5);
    Control := New(PRadiobuttons, Init(R,
      NewSItem(GetString(431),          {'~g~esamten Text'}
      NewSItem(GetString(432),Nil))));  {'~m~arkierten Text'}
    Insert(Control);

    R.Assign(12,2,18,3);                {'~T~ext:'}
    Insert(New(PLabel, Init(R, GetString(433), Control)));

    R.Assign(13,7,34,10);
    Control := New(PRadiobuttons, Init(R,
      NewSItem(GetString(437),          {'~P~C zu HP'}
      NewSItem(GetString(438),          {'~H~P zu PC'}
      NewSItem(GetString(439),Nil))))); {'~P~C zu PC'}
    Insert(Control);

    R.Assign(12,6,22,7);                {'~R~ichtung'}
    Insert(New(PLabel, Init(R, GetString(440), Control)));

    R.Assign(3,14,16,16);
    Control := New(PButton, Init(R, GetString(10), cmOK, bfDefault));
    Insert(Control);

    R.Assign(17,14,30,16);
    Control := New(PButton, Init(R, GetString(13), cmHelp, bfNormal));
    Insert(Control);

    R.Assign(31,14,44,16);
    Control := New(PButton, Init(R, GetString(12), cmCancel, bfNormal));
    Insert(Control);

    SelectNext(False);
  end;

  if Application^.ExecuteDialog(Dlg, @Switch) = cmOk then
  begin
    case Switch.s1 of
      $00: s1:= GetString(441);  {'gesamten Text'}
      $01: s1:= GetString(442);  {'markierten Text'}
    end;
    case Switch.s2 of
      $00: s2:= 'PC -> HP';
      $01: s2:= 'HP -> PC';
      $02: s2:= 'PC -> PC';
    end;

    P:= nil;
    ConvertDialog:= New(PConvertDlg, Init(@s1, @s2, cvManuell));
    Desktop^.Insert(ConvertDialog);

    Pos:= CurPtr;
    if Switch.s1 = $00 then SetCurPtr(BufLen, 0);

    case Switch.s1 of
      $00: P:= new(PParser, Init(@self, Switch.s2 + 4, 0, BufLen));
      $01: P:= new(PParser, Init(@self, Switch.s2 + 4, SelStart, SelEnd));
    end;

    if (Switch.s1 = $00) and (Pos <= BufLen) then
      SetCurPtr(Pos, 0);

    Desktop^.Delete(ConvertDialog);
    Dispose(ConvertDialog, Done);
    ConvertDialog:= nil;
    if Assigned(P) then Dispose(P, Done);
  end;
end;



procedure TEditor.SendText(ATitle: string; AHelpCtx: word);
var
  Dlg : PDialog;
  R : TRect;
  Control, HScroll : PView;
  I: Word;
  Switch: word;
begin
  Switch:= $00;
  R.Assign(0,0,47,12);
  Dlg:= New(PDialog, Init(R, ATitle));
  with Dlg^ do
  begin
    Options:= Options or ofCentered;
    HelpCtx:= AHelpCtx;

    R.Assign(5, 1, 42, 7);
    Insert(New(P3D_Frame, Init(R)));

    R.Assign(13,3,34,5);
    Control := New(PRadiobuttons, Init(R,
    NewSItem(GetString(431),           {'~g~esamten Text'}
    NewSItem(GetString(432),Nil))));   {'~m~arkierten Text'}
    Insert(Control);

    R.Assign(12,2,21,3);               {'~T~ext:'}
    Insert(New(PLabel, Init(R, GetString(433), Control)));

    R.Assign(3,9,16,11);
    Control := New(PButton, Init(R, GetString(10), cmOK, bfDefault));
    Insert(Control);

    R.Assign(17,9,30,11);
    Control := New(PButton, Init(R, GetString(11), cmHelp, bfNormal));
    Insert(Control);

    R.Assign(31,9,44,11);
    Control := New(PButton, Init(R, GetString(12), cmCancel, bfNormal));
    Insert(Control);

    SelectNext(False);
  end;
  if Application^.ExecuteDialog(Dlg, @Switch) = cmOk then
  begin
    with SendRec^ do
    begin
      case Switch of
        $00: begin
               Option:= 2;
               Size  := BufLen;
               Start := 0;
               Stop  := BufLen;
             end;
        $01: begin
               Option:= 1;
               Size  := SelEnd - SelStart;
               Start := SelStart;
               Stop  := SelEnd;
             end;
      end;
      Editor:= @self;
    end;
    Message(Application, evBroadCast, cmSendRecord, SendRec);
  end;
end;


procedure TEditor.Draw;
var i, s, ag, bg: word;
begin
  if DrawLine <> Delta.Y then
  begin
    DrawPtr := LineMove(DrawPtr, Delta.Y - DrawLine);
    DrawLine := Delta.Y;
  end;

  IsAString:= 0;
  IsAList:= 0;

  if (Delta.Y > 0) then
  begin
    s:= LineStart(DrawPtr)-1;
    for i:= 0 to s do
      if BufChar(i) = '"' then
        inc(IsAString)
      else
        { nur ausserhalb von Strings Ausschau nach Listen halten. }
        if (IsAString mod 2 = 0) then
        begin
          if BufChar(i) = '{' then inc(IsAList);
          if BufChar(i) = '}' then dec(IsAList);
        end;
  end;

  DrawLines(0, Size.Y, DrawPtr);
end;

procedure TEditor.DrawLines(Y, Count: Integer; LinePtr: Word);
var
  Color: Word;
  B: array[0..MaxLineLength - 1] of Word;
begin
  Color := GetColor($0201);
  while Count > 0 do
  begin
{    FormatLine(B, LinePtr, Delta.X + Size.X, Color);}
    if (Delta.X+Size.X) > (LineEnd(LinePtr)-LineStart(LinePtr)) then
      FormatLine(B, LinePtr, Delta.X + Size.X, Color) else
      FormatLine(B, LinePtr, LineEnd(LinePtr)-LineStart(LinePtr)+1, Color);

    if Displays and (not IsClipboard) then DrawDisplay(B, Y);

    if SyntaxHighlight and (not IsClipboard) then
{      if (Delta.X+Size.X) >= (LineEnd(LinePtr)-LineStart(LinePtr)) then
        DrawSyntax (B, Y, Delta.X + Size.X) else}
        DrawSyntax (B, Y, LineEnd(LinePtr)-LineStart(LinePtr));

    WriteBuf(0, Y, Size.X, 1, B[Delta.X]);
    LinePtr := NextLine(LinePtr);
    Inc(Y);
    Dec(Count);
  end;
end;


procedure TEditor.DrawDisplay(var B: array of word; Y: integer);
var
  Color, Tmp: Word;
  i: integer;

  function IsSelected(w: word): boolean;
  var Color: word;
  begin
    Color:= GetColor($0201);
    if Hi(w) = Hi(Color) then IsSelected:= true else IsSelected:= false;
  end;

  function IsDisplayLine: boolean;
  var
    d: boolean;
    Num: integer;
  begin
    d:= false;
    Y:= Delta.Y + Y;
    Num:= Y div (DisplayHight + DisplayDistance);
    if Num = 0 then
      if Y >= DisplayDistance then d:= true else d:= false
    else
      if Y >= (Num*(DisplayDistance+DisplayHight))+DisplayDistance then
        d:= true else d:= false;
    IsDisplayLine:= d;
  end;

begin
  if IsDisplayLine then
  begin
    Color:= GetColor($0304);
    for i:= 0 to DisplayLength - 1 do
      if not IsSelected(B[i]) then
      begin
        Tmp:= B[i] and $00FF;
        Tmp:= (Hi(Color)*256) + Tmp;
        B[i]:= Tmp;
      end else
      begin
        Tmp:= B[i] and $00FF;
        Tmp:= (Lo(Color)*256) + Tmp;
        B[i]:= Tmp;
      end;
  end;
end;


procedure TEditor.DrawSyntax (var B: array of word; Y: integer; MaxX: word);
var
  Pos, x1, x2: word;
  c, clrString, clrComment, clrList, clrError: word;
  s: TSyntaxString;

  function IsString(w: word): boolean;
  begin
    IsString:= (w and $0F00) = clrString;
  end;

  function IsComment(w: word): boolean;
  begin
    IsComment:= (w and $0F00) = clrComment;
  end;

  function IsList(w: word): boolean;
  begin
    IsList:= (w and $0F00) = clrList;
  end;

  procedure ScanForStrings;
  var i: word;
  begin
    for i:= 0 to MaxX do
    begin
      if Lo(B[i]) = ord('"') then
        if (IsAString mod 2 = 0) then
        begin
          inc(IsAString);            { String Anfang                      }
        end else
        begin
          B[i]:= B[i] and $F0FF;     { String beenden, " aber noch farbig }
          B[i]:= B[i] or clrString;
          inc(IsAString);
        end;
      if (IsAString mod 2 <> 0) then
      begin
        B[i]:= B[i] and $F0FF;       { String farbig darstellen           }
        B[i]:= B[i] or clrString;
      end;
    end;
  end;

  procedure ReScanForStrings;
  var i: word;
  begin
    for i:= 1 to MaxX do
      if IsString(B[i]) and IsComment(B[i-1]) then
      begin
        B[i]:= B[i] and $F0FF;
        B[i]:= B[i] or clrComment;
      end;
  end;

  procedure ScanForComments;
  var
    i: word;
    IsAComment: boolean;
  begin
    IsAComment:= false;
    for i:= 0 to Delta.X + Size.X do
    begin
      if Lo(B[i]) = ord('@') then
        if not IsString(B[i]) then
          if (not IsAComment) then
          begin
            IsAComment:= true;       { Kommentar Anfang                   }
          end else
          begin
            B[i]:= B[i] and $F0FF;   { Kommentar Ende, @ aber noch farbig }
            B[i]:= B[i] or clrComment;
            IsAComment:= false;
          end;
      if (not IsString(B[i])) and IsAComment then
      begin
        B[i]:= B[i] and $F0FF;       { Kommentar farbig darstellen        }
        B[i]:= B[i] or clrComment;
      end;
    end;
  end;

  procedure ScanForLists;

     function IsWhat(i: integer): integer;
     begin
       if i < 0 then IsWhat:= 0 else
       if i = 0 then IsWhat:= 1 else
                     IsWhat:= 2;
     end;

  var
    i: word;
  begin
    for i:= 0 to MaxX do
    begin
      if (not IsString(B[i])) and (not IsComment(B[i])) then
      begin

        case IsWhat(IsAlist) of

          0: { kleiner Null }
             begin
               if Lo(B[i]) = ord('{') then
               begin
                 B[i]:= B[i] and $00FF;
                 B[i]:= B[i] or clrError;
               end;
               if Lo(B[i]) = ord('}') then
               begin
                 B[i]:= B[i] and $00FF;
                 B[i]:= B[i] or clrError;
               end;
             end;
          1: { gleich Null }
             begin
               if Lo(B[i]) = ord('{') then
               begin
                 B[i]:= B[i] and $F0FF;
                 B[i]:= B[i] or clrList;
                 inc(IsAList);
               end;
               if Lo(B[i]) = ord('}') then
               begin
                 B[i]:= B[i] and $00FF;
                 B[i]:= B[i] or clrError;
                 dec(IsAList);
               end;
             end;
          2: { groesser Null }
             begin
               B[i]:= B[i] and $F0FF;
               B[i]:= B[i] or clrList;
               if Lo(B[i]) = ord('{') then inc(IsAList);
               if Lo(B[i]) = ord('}') then dec(IsAList);
             end;
        end;

      end;
    end;
  end;

  procedure PutColor(c, x1, x2: word);
  var i: word;
  begin
    for i:= x1 to x2 do
    begin
        B[i]:= B[i] and $F0FF;       { Keyword farbig darstellen         }
        B[i]:= B[i] or c;
      end;
  end;

  function GetWord(var Pos, x1, x2: word): TSyntaxString;
  var
    i: word;
    s: TSyntaxString;
  begin
    while IsComment(B[Pos]) or IsString(B[Pos]) or
          IsList(B[Pos]) or (Lo(B[Pos]) = ord(' ')) do inc(Pos);
    x1:= Pos;
    while (not IsComment(B[Pos]))  and
          (not IsString(B[Pos]))   and
          (not IsList(B[Pos]))     and
          (Lo(B[Pos]) <> ord(' ')) and
          (Lo(B[Pos]) <> 10)       and
          (Lo(B[Pos]) <> 13)       and
          (Pos < Delta.X+Size.X)   do inc(Pos);
    x2:= Pos-1;
    s:= '';
    if (x2 - x1) > SizeOf(TSyntaxString) then
      x1:= x2 - SizeOf(TSyntaxString);
    for i:= x1 to x2 do s:= s + chr(Lo(B[i]));
    GetWord:= s;
  end;

begin
  { Default-Werte }
  clrComment:= $0100;
  clrString := $0F00;
  clrList   := $0500;
  clrError  := $4F00;
  { Aktuelle Werte Laden }
  SyntaxList^.GetColor('@Comments',    clrComment);
  SyntaxList^.GetColor('" Strings "',  clrString);
  SyntaxList^.GetColor('{ Lists }',    clrList);

  ScanForStrings;       { Strings    }
  ScanForComments;      { Kommentare }
  ScanForLists;         { Listen }
  ReScanForStrings;     { Strings innerhalb von Kommentaren oder Listen }

  Pos := 0;
  while Pos < Delta.X+Size.X do
  begin
    s:= GetWord(Pos, x1, x2);
    if SyntaxList^.GetColor(s, c) then
      PutColor(c, x1, x2);
  end;
end;


[...]

{************************************************}
{                                                }
{   UNIT HPTrans   Transfer-Routinen             }
{   Copyright (c) 1994-98 by Tom Wellige         }
{                                                }
{   Part of HPShell                              }
{   Integrated Developing Environment            }
{   for HP48 calculators                         }
{                                                }
{   Author: Tom Wellige                          }
{   E-Mail: wellige@t-online.de                  }
{                                                }
{   These sources can be freely used as long     }
{   as their origin is stated in the             }
{   resulting program (code *and* exe)           }
{                                                }
{************************************************}

(* 28.04.95  Fehlermeldungen im Klartext hinzugef�gt.                  *)
(* 01.05.95  Fehlermeldungen erweitert.                                *)
(* 01.05.95  CHECKIFFILESARETHERE:                                     *)
(*            - Fehler in Nummernberechnung entf.                      *)
(*            - Abfrage hinzugef�gt, ob umbenannt werden soll.         *)
(* 14.05.95  Fehlerabfrage, ob w„hrend šbertragung ein Fehler aufge-   *)
(*             treten ist ( 0 < w < 256 )                              *)
(* 28.06.95  DeleteHPHeaders: Check l„uft mittels Block-Fkt., so daá   *)
(*             er unabh„ngig von der Zeilenl„nge wird -> GROBs !       *)
(*           DeleteBrqckets : Check l„uft mittels Block-Fkt., so daá   *)
(*             er unabh„ngig von der Zeilenl„nge wird -> GROBs !       *)
(* 08.12.98  MakeKermitFile: Anstelle von "*.*" bzw. "*." wird nun     *)
(*             pro Datei eine "send" Zeile eingef�gt.                  *)

unit HPTrans;

{$O+,F+}

interface

uses
  Dos, Objects, Drivers, App, Views, Dialogs, MsgBox,
  MultiF, MsgObj, Tone,
  TWApp, TWMsgBox, TWWindow, TWDialog, TWGlobal, TWCommon, TWDos,
  HPGlobal, HPChars, HPProt, HPPort;

const
  kmSend          = 1;
  kmSendBinary    = 2;
  kmReceive       = 3;
  kmReceiveBinary = 4;


(* ermittelt alle Files in beliebigem Verzeichnis *)
function GetFileList(d: string): PFileNames;
(* �berpr�ft Files nach Namesregeln f�r HP *)
function CheckFileNames(List: PFileNames): boolean;
(* kopiert Files in beliebiges Verzeichnis *)
function CopyFiles(List: PFileNames; d: string): boolean;
(* l”scht alle Dateien im Verzeichnis *)
function DeleteFiles(d: string): boolean;
(* F�gt mehrere Dateien zu einer zusammen *)
(* gibt FALSE und FRESULT=0 zur�ck, wenn Speicherfehler auftritt. *)
function MergeFiles(var List: PFileNames; FName: string): boolean;

(* �berpr�ft, ob Datei schon vorhanden ist, und benennt ggf. um *)
procedure CheckIfFilesAreThere(var List: PFileNames; d: string);


(* konvertiert Files *)
function ConvertFiles(List: PFileNames; AOption: word): boolean;
(* l”scht HP-Header aus Dateien *)
function DeleteHPHeaders(List: PFileNames): boolean;
(* l”scht Programmklammern *)
function DeleteBrackets(List: PFileNames): boolean;

(* Liefert Aufrufparameter f�r externes Protokoll zur�ck *)
function CalcExternalParameters(p: string): string;


(* Ruft KERLITE.EXE zum Senden auf *)
procedure SendKermitProtocol(binary: boolean; List: PFileNames);
(* Ruft KERLITE.EXE zum Empfangen auf *)
function ReceiveKermitProtocol(binary: boolean): boolean;
(* Ruft externes Protokoll zum Senden auf *)
procedure SendExternalProtocol;
(* Ruft externes Protokoll zum Empfangen auf *)
function ReceiveExternalProtocol: boolean;


(* Erzeugt MSKERMIT.INI Datei f�r KERLITE.EXE *)
function MakeKermitFile(Option: word; List: PFileNames): boolean;

type
  PHPInputLine = ^THPInputLine;
  THPInputLine = object(TInputLine)
    function Valid(Command: word): boolean; virtual;
  end;


implementation

type
  PWord = ^word;

(********************************************************************)
(**                     THPInputLine                               **)
(********************************************************************)

function THPInputLine.Valid(command: word): boolean;
var
  Ok: boolean;
  i: integer;
  Event: TEvent;
begin
  Ok:= true;
  if length(Data^)>0 then
    if not (command= cmCancel) then
    begin
      if not CheckObjectName(Data^) then
      begin
        Ok:= false;
        OneStringRec:= Data;
        { Der Variablenname "%s" ist nach der HP48-Namenskonvention ung�ltig.}
        FormatStr(ToFormatString, GetString(1312), OneStringRec);
        ErrorBox(#3+ToFormatString, nil, mfOkBeep);
        Event.What:= evCommand;
        Event.Command:= 234;  { Hilfefenster "Namengebung" }
        Application^.PutEvent(Event);
        Select;
      end;
    end;
  if Ok then valid:= inherited Valid(Command) else valid:= false;
end;



(********************************************************************)
(**               procedure SendKermitProtocol                     **)
(********************************************************************)

procedure SendKermitProtocol(binary: boolean; List: PFileNames);
var
  ok: boolean;
  s: string;
begin
  if not binary then
    ok:= MakeKermitFile(kmSend, List) else
    ok:= MakeKermitFile(kmSendBinary, List);
  if ok then
  begin
    s:= Dirs.Prog + 'kerlite';
    Message(Application, evCommand, cmCallProtocol, @s);
    if (CallReturn < 256) and (CallReturn > 0) then
         {'šbetragungsprotokoll wurde durch den Benutzer oder
           einen Fehler abgebrochen.'}
      ErrorBox(#3+GetString(1461), nil, mfOkBeep);
    FDelete(Dirs.Temp + 'MSKERMIT.INI');
  end;
end;


(********************************************************************)
(**               procedure ReceiveKermitProtocol                  **)
(********************************************************************)

function ReceiveKermitProtocol(binary: boolean): boolean;
var
  ok: boolean;
  s: string;
begin
  if not binary then
    ok:= MakeKermitFile(kmReceive, nil) else
    ok:= MakeKermitFile(kmReceiveBinary, nil);
  if ok then
  begin
    s:= Dirs.Prog + 'kerlite';
    Message(Application, evCommand, cmCallProtocol, @s);
    if (CallReturn < 256) and (CallReturn > 0) then
         {'šbetragungsprotokoll wurde durch den Benutzer oder
           einen Fehler abgebrochen.'}
      ErrorBox(#3+GetString(1461), nil, mfOkBeep);
    FDelete(Dirs.Temp + 'MSKERMIT.INI');
  end;
  ReceiveKermitProtocol:= CallReturn = 0;
end;


(********************************************************************)
(**               procedure MakeKermitFile                         **)
(********************************************************************)

function MakeKermitFile(Option: word; List: PFileNames): boolean;
var
  INI: Text;
  p: PFileRec;
  i: integer;
begin
  assign(INI, Dirs.Temp + 'MSKERMIT.INI');
  {$I-} rewrite(INI); {$I+}
  if IOresult <> 0 then
  begin
    {'Steuerdatei f�r KERLITE.EXE konnte nicht erstellt werden.'}
    ErrorBox(#3+GetString(1420), nil, mfOkBeep);
    MakeKermitFile:= false;
    Exit;
  end;

  writeln(INI, '; FILE MSKERMIT.INI');
  writeln(INI, '; ');
  writeln(INI, '; Created by HPShell ' + ShellVer + ' ' + CopyRightStr);
  writeln(INI, '; ');
  writeln(INI, '; Do NOT make any changes in this file since it will be overwritten');
  writeln(INI, '; each time you start a transmission between PC and HP48 !');
  writeln(INI, '; ');
  writeln(INI);

  writeln(INI, '; Parameter');
  writeln(INI, 'set port com', ComPort.COM+1);
  case ComPort.PORT[ComPort.COM] of
    0: writeln(INI, 'set com', ComPort.COM+1, ' \x03f8 ', ComPort.IRQ[ComPort.COM]+2);
    1: writeln(INI, 'set com', ComPort.COM+1, ' \x02f8 ', ComPort.IRQ[ComPort.COM]+2);
    2: writeln(INI, 'set com', ComPort.COM+1, ' \x03e8 ', ComPort.IRQ[ComPort.COM]+2);
    3: writeln(INI, 'set com', ComPort.COM+1, ' \x02e8 ', ComPort.IRQ[ComPort.COM]+2);
  end;
  case ComPort.BAUD of
    0: writeln(INI, 'set speed 1200');
    1: writeln(INI, 'set speed 2400');
    2: writeln(INI, 'set speed 4800');
    3: writeln(INI, 'set speed 9600');
  end;
  case ComPort.PARITY of
    0: writeln(INI, 'set parity none');
    1: writeln(INI, 'set parity even');
    2: writeln(INI, 'set parity odd');
    3: writeln(INI, 'set parity space');
    4: writeln(INI, 'set parity mark');
  end;
  writeln(INI, 'set block-check 3');
  writeln(INI);

  writeln(INI, '; Prompt');
  writeln(INI, 'set prompt HPShell-Kermit>');
  writeln(INI);

  writeln(INI, '; Transmission');
  if Option in [kmSendBinary, kmReceiveBinary] then
                                writeln(INI, 'set file type binary');
  case Option of
    kmReceive, kmReceiveBinary:
      begin
        writeln(INI, 'receive');
      end;

    kmSend, kmSendBinary:
      begin
        { pro Datei eine "send" Zeile einf�gen }
        for i:= 0 to List^.Count-1 do
        begin
          p:= PFileRec(List^.At(i));
          writeln(INI, 'send ' + p^.Name);
        end;
      end;
  end;
  writeln(INI);

  writeln(INI, '; Quit');
  writeln(INI, 'quit');

  close(INI);

  FCopy(Dirs.Temp + 'MSKERMIT.INI', Dirs.Prog + 'MSKERMIT.INI');

  MakeKermitFile:= true;
end;


(********************************************************************)
(**               procedure SendExternalProtocol                   **)
(********************************************************************)

procedure SendExternalProtocol;
var
  s, p: string;
  i, y: integer;
  l: PFileNames;
  r: PFileRec;
begin
  s:= CalcExternalParameters(Protocol.Field2);  (* senden *)
  if Pos('*.*', s) = 0 then
  begin
    p:= '';
    l:= GetFileList(Dirs.Temp);
    if assigned(l) then
    begin
      for i:= 0 to l^.Count-1 do
      begin
        r:= PFileRec(l^.at(i));
        y:= length(r^.Name);
        while r^.Name[y] <> '\' do dec(y);
        System.Delete(r^.Name, 1, y);
        if Pos('.', r^.Name) = 0 then r^.Name:= r^.Name + '.';
        p:= p + r^.Name + ' ';
      end;
      p:= copy(p, 1, length(p)-1);
      Dispose(l, done);
    end;
    s:= s + ' ' + p;
  end;
  Message(Application, evCommand, cmCallProtocol, @s);
  if (CallReturn < 256) and (CallReturn > 0) then
       {'šbetragungsprotokoll wurde durch den Benutzer oder
         einen Fehler abgebrochen.'}
    ErrorBox(#3+GetString(1461), nil, mfOkBeep);
end;


(********************************************************************)
(**               procedure ReceiveExternalProtocol                **)
(********************************************************************)

function ReceiveExternalProtocol: boolean;
var
  s: string;
begin
  s:= CalcExternalParameters(Protocol.Field3);  (* empfangen *)
  Message(Application, evCommand, cmCallProtocol, @s);
  if (CallReturn < 256) and (CallReturn > 0) then
       {'šbetragungsprotokoll wurde durch den Benutzer oder
         einen Fehler abgebrochen.'}
    ErrorBox(#3+GetString(1461), nil, mfOkBeep);
  ReceiveExternalProtocol:= CallReturn = 0;
end;


(********************************************************************)
(**               function CalcExternalParamters                   **)
(********************************************************************)

function CalcExternalParameters(p: string): string;
const
  BaudArray  : array[0..3] of string = ('1200','2400','4800','9600');
  ParityArray: array[0..4] of string = ('NONE','EVEN','ODD','SPACE','MARK');
  PortArray  : array[0..3] of string = ('03F8','02F8','03E8','02E8');
var
  s: string;

  procedure Replace(var s: string; old, new: string);
  var
    i: integer;
    u: string;
  begin
    u:= UpString(s);
    while Pos(old, u) <> 0 do
    begin
      i:= Pos(old, u);
      Delete(s, i, length(old));
      Insert(new, s, i);
      u:= UpString(s);
    end;
  end;

begin

  str(ComPort.COM+1, s);
  Replace(p, '#COM', s);

  s:= BaudArray[ComPort.Baud];
  Replace(p, '#BAUD', s);

  s:= ParityArray[ComPort.Parity];
  Replace(p, '#PARITY', s);

  s:= PortArray[ComPort.COM];
  Replace(p, '#PORT', s);

  str(ComPort.IRQ[ComPort.COM]+2, s);
  Replace(p, '#IRQ', s);

  CalcExternalParameters:= p
end;


(********************************************************************)
(**                function DeleteBrackets                         **)
(********************************************************************)

function DeleteBrackets(List: PFileNames): boolean;
const TempFile : string = '~DELBRAC.TMP';
type
  PBuff = ^TBuff;
  TBuff = array[1..2048] of byte;   (* BuffergrӇe 2kB ! *)

  procedure CheckBrackets(Buff: PBuff; var NumRead: word);
  var i, j: integer;
  begin
    if (chr(Buff^[1]) = '\') and (chr(Buff^[2]) = '<') and
       (chr(Buff^[3]) = '<') then
    begin
      i:= 1;
      while Buff^[i] <> 32 do inc(i);
      inc(i);
      for j:= i to NumRead do Buff^[j-i+1]:= Buff^[j];
      NumRead:= NumRead - i + 1;
    end;
  end;

var
  org, tmp  : file;
  org2, tmp2: file of char;
  i: integer;
  j,k: longint;
  b: char;
  ok: boolean;
  s, error, number: string;
  p: PFileRec;
  W: PMessageWindow;
  Buff: PBuff;
  NumRead, NumWritten: word;
begin
  ok:= false;
  FResult:= 0;
  for i:= 0 to List^.Count-1 do
  begin
    p:= PFileRec(List^.At(i));
    OneStringRec:= PString(@p^.Name);  {'Datei: %s'}
    FormatStr(s, GetString(906), OneStringRec);
    W:= New(PMessageWindow, Init('Deleting Brackets...', @s));
    Desktop^.Insert(W);

    assign(org,  p^.Name);
    assign(org2, p^.Name);
    assign(tmp,  TempFile);
    assign(tmp2, TempFile);
    {$I-} reset(org,1); {$I+}
    FResult:= IOresult;
    if FResult <> 0 then
    begin
      Number:= '1';
      str(FResult, Error);
      TwoStringRec.s1:= PString(@Number);
      TwoStringRec.s2:= PString(@Error);
         {'Fehler (%s,%s) beim Entfernen der Programmklammern.'}
      ErrorBox(#3+GetString(1063), @TwoStringRec, mfOkBeep);
    end else
    begin
      {$I-} rewrite(tmp,1); {$I+}
      FResult:= IOresult;
      if FResult<> 0 then
      begin
        Number:= '2';
        str(FResult, Error);
        TwoStringRec.s1:= PString(@Number);
        TwoStringRec.s2:= PString(@Error);
           {'Fehler (%s,%s) beim Entfernen der Programmklammern.'}
        ErrorBox(#3+GetString(1063), @TwoStringRec, mfOkBeep);
      end else
      begin
        if MaxAvail < SizeOf(Buff^) then ok:= false else
        begin
          New(Buff);
          j:= 1;
          repeat
            BlockRead(org, Buff^, SizeOf(Buff^), NumRead);
            if j = 1 then CheckBrackets(Buff, NumRead);
            BlockWrite(tmp, Buff^, NumRead, NumWritten);
            inc(j);
          until (NumRead = 0) or (NumWritten <> NumRead);
          Dispose(Buff);

          close(org);
          close(tmp);

          reset(tmp2);
          j:= filesize(tmp2)-1;
          seek(tmp2, j);
          read(tmp2, b);
          while b in [#10,#13,#32,'>','\'] do
          begin
            dec(j);
            seek(tmp2, j);
            read(tmp2, b);
          end;

          seek(tmp2, 0);
          rewrite(org2);

          for k:= 0 to j do
          begin
            read (tmp2, b);
            write(org2, b);
          end;

          close(org2);
          close(tmp2);

          ok:= FDelete(TempFile);
          if not ok then
          begin
            Number:= '3';
            str(FResult, Error);
            TwoStringRec.s1:= PString(@Number);
            TwoStringRec.s2:= PString(@Error);
               {'Fehler (%s,%s) beim Entfernen der Programmklammern.'}
            ErrorBox(#3+GetString(1063), @TwoStringRec, mfOkBeep);
          end;
        end;
      end;
    end;
    Desktop^.Delete(W);
    Dispose(W, Done);
  end;
  DeleteBrackets:= ok;
end;


(********************************************************************)
(**                function DeleteHPHeaders                        **)
(********************************************************************)

function DeleteHPHeaders(List: PFileNames): boolean;
const TempFile : string = '~DELHEAD.TMP';
type
  PBuff = ^TBuff;
  TBuff = array[1..2048] of byte;   (* BuffergrӇe 2kB ! *)

  procedure CheckHeader(Buff: PBuff; var NumRead: word);
  var i, j: integer;
  begin
    if (chr(Buff^[1]) = '%') and (chr(Buff^[2]) = '%') and
       (chr(Buff^[3]) = 'H') and (chr(Buff^[4]) = 'P') then
    begin
      i:= 1;
      while Buff^[i] <> 10 do inc(i);
      inc(i);
      for j:= i to NumRead do Buff^[j-i+1]:= Buff^[j];
      NumRead:= NumRead - i + 1;
    end;
  end;

var
  org, tmp: file;
  i, j: integer;
  ok: boolean;
  s, error, number: string;
  p: PFileRec;
  W: PMessageWindow;
  Buff: PBuff;
  NumRead, NumWritten: word;
begin
  ok:= false;
  FResult:= 0;
  for i:= 0 to List^.Count-1 do
  begin
    p:= PFileRec(List^.At(i));
    OneStringRec:= PString(@p^.Name);  {'Datei: %s'}
    FormatStr(s, GetString(906), OneStringRec);
    W:= New(PMessageWindow, Init('Deleting Header...', @s));
    Desktop^.Insert(W);

    assign(org, p^.Name);
    assign(tmp, TempFile);
    {$I-} reset(org,1); {$I+}
    FResult:= IOresult;
    if FResult <> 0 then
    begin
      Number:= '1';
      str(FResult, Error);
      TwoStringRec.s1:= PString(@Number);
      TwoStringRec.s2:= PString(@Error);
         {'Fehler (%s,%s) beim Entfernen des šbertragungsheaders.'}
      ErrorBox(#3+GetString(1061), @TwoStringRec, mfOkBeep);
    end else
    begin
      {$I-} rewrite(tmp,1); {$I+}
      FResult:= IOresult;
      if FResult<> 0 then
      begin
        Number:= '2';
        str(FResult, Error);
        TwoStringRec.s1:= PString(@Number);
        TwoStringRec.s2:= PString(@Error);
           {'Fehler (%s,%s) beim Entfernen des šbertragungsheaders.'}
        ErrorBox(#3+GetString(1061), @TwoStringRec, mfOkBeep);
      end else
      begin
        if MaxAvail < SizeOf(Buff^) then ok:= false else
        begin
          New(Buff);
          j:= 1;
          repeat
            BlockRead(org, Buff^, SizeOf(Buff^), NumRead);
            if j = 1 then CheckHeader(Buff, NumRead);
            BlockWrite(tmp, Buff^, NumRead, NumWritten);
            inc(j);
          until (NumRead = 0) or (NumWritten <> NumRead);
          Dispose(Buff);

          close(org);
          close(tmp);

          ok:= FDelete(p^.Name);
          if not ok then
          begin
            Number:= '3';
            str(FResult, Error);
            TwoStringRec.s1:= PString(@Number);
            TwoStringRec.s2:= PString(@Error);
               {'Fehler (%s,%s) beim Entfernen des šbertragungsheaders.'}
            ErrorBox(#3+GetString(1061), @TwoStringRec, mfOkBeep);
          end else
          begin
            ok:= FRename(TempFile, p^.Name);
            if not ok then
            begin
              Number:= '4';
              str(FResult, Error);
              TwoStringRec.s1:= PString(@Number);
              TwoStringRec.s2:= PString(@Error);
                 {'Fehler (%s,%s) beim Entfernen des šbertragungsheaders.'}
              ErrorBox(#3+GetString(1061), @TwoStringRec, mfOkBeep);
            end;
          end;
        end;
      end;
    end;
    Desktop^.Delete(W);
    Dispose(W, Done);
  end;
  DeleteHPHeaders:= ok;
end;


(********************************************************************)
(**                   function ConvertFiles                        **)
(********************************************************************)

function ConvertFiles(List: PFileNames; AOption: word): boolean;
var
  P: PParser;
  s, f: string;
  i: integer;
  rec: PFileRec;
begin
  for i:= 0 to List^.Count-1 do
  begin
    rec:= PFileRec(List^.At(i));
    s:= rec^.Name;
    case AOption of
      psPCtoHP, psTextPCtoHP: f:= 'PC -> HP';
      psHPtoPC, psTextHPtoPC: f:= 'HP -> PC';
    end;
    ConvertDialog:= New(PConvertDlg, Init(@s, @f, cvAutomatisch));
    Desktop^.Insert(ConvertDialog);
    P:= new(PParser, Init(@rec^.Name, AOption, 0, 0));
    Desktop^.Delete(ConvertDialog);
    Dispose(ConvertDialog, Done);
    ConvertDialog:= nil;
    if assigned(P) then Dispose(P, Done);
  end;
end;


(********************************************************************)
(**                   function GetFileList                         **)
(********************************************************************)

function GetFileList(d: string): PFileNames;
var
  p: PFileNames;
  s: SearchRec;
  r: PFileRec;

  function GetPFileRec(s: SearchRec): PFileRec;
  var r: PFileRec;
  begin
    r:= New(PFileRec);
    r^.Name:= d + s.Name;
    r^.Attr:= s.Attr;
    r^.Time:= s.Time;
    r^.Size:= s.Size;
    GetPFileRec:= r;
  end;

begin
  p:= nil;
  FindFirst(d + '*.*', Archive, s);
  if DOSError = 0 then
  begin
    p:= New(PFileNames, Init(10, 2));
    r:= GetPFileRec(s);
    p^.Insert(r);
    while DOSError = 0  do
    begin
      FindNext(s);
      if DOSError = 0 then
      begin
        r:= GetPFileRec(s);
        p^.Insert(r);
      end;
    end;
  end;
  GetFileList:= p;
end;


(********************************************************************)
(**                   function CheckFileNames                      **)
(********************************************************************)

function CheckFileNames(List: PFileNames): boolean;
var
  i    : integer;
  s, f : string;
  ok   : boolean;
  p    : PFileRec;
  FDir : DirStr;
  FName: NameStr;
  FExt : ExtStr;
begin
  ok:= true;
  if not assigned(List) then
  begin
    CheckFileNames:= false;
    exit;
  end;
  for i:= 0 to List^.Count-1 do
    if ok then
    begin
      p:= PFileRec(List^.At(i));
      FSplit(p^.Name, FDir, FName, FExt);
      if FExt = '.' then FExt:= '';
      if not CheckObjectName(FName + FExt) then
        ok:= EnterObjectName(p);
    end;
  CheckFileNames:= ok;
end;


(********************************************************************)
(**                   function CopyFiles                           **)
(********************************************************************)

function CopyFiles(List: PFileNames; d: string): boolean;
var
  i    : integer;
  ok   : boolean;
  p    : PFileRec;
  FDir : DirStr;
  FName: NameStr;
  FExt : ExtStr;
begin
  ok:= true;
  for i:= 0 to List^.Count-1 do
    if ok then
    begin
      p:= PFileRec(List^.At(i));
      FSplit(p^.Name, FDir, FName, FExt);
      ok:= FCopy(p^.Name, d + FName + FExt);
    end;
  CopyFiles:= ok;
end;


(********************************************************************)
(**                   function DeleteFiles                         **)
(********************************************************************)

function DeleteFiles(d: string): boolean;
var
  i    : integer;
  ok   : boolean;
  p    : PFileRec;
  FDir : DirStr;
  FName: NameStr;
  FExt : ExtStr;
  List: PFileNames;
begin
  ok:= true;
  List:= GetFileList(d);
  if assigned(List) then
  begin
    for i:= 0 to List^.Count-1 do
      if ok then
      begin
        p:= PFileRec(List^.At(i));
        FSplit(p^.Name, FDir, FName, FExt);
        ok:= FDelete(d + FName + FExt);
      end;
  end;
  DeleteFiles:= ok;
end;


(********************************************************************)
(**                function MergeFiles                             **)
(********************************************************************)

function MergeFiles(var List: PFileNames; FName: string): boolean;
type
  PBuff = ^TBuff;
  TBuff = array[1..8192] of byte;   (* BuffergrӇe 8kB ! *)
var
  ok: boolean;
  s, d: file;
  NumRead, NumWrite: word;
  Buff: PBuff;
  i: integer;
  p: PFileRec;
begin
  ok:= true;
  FResult:= 0;
  assign(d, FName);
  {$I-} rewrite(d, 1); {$I+}
  FResult:= IOresult;
  if FResult <> 0 then ok:= false else
  begin
    if MaxAvail < SizeOf(Buff^) then ok:= false else
    begin
      New(Buff);
      for i:= 0 to List^.Count-1 do
      begin
        assign(s, PFileRec(List^.At(i))^.Name);
        {$I-} reset(s, 1); {$I+}
        FResult:= IOresult;
        if FResult <> 0 then
        begin
          MergeFiles:= false;
          Dispose(List, Done);
          Exit;
        end;
        repeat
          BlockRead(s, Buff^, SizeOf(Buff^), NumRead);
          BlockWrite(d, Buff^, NumRead, NumWrite);
          ok:= NumRead = NumWrite;
        until (NumRead = 0) or (not ok);
        close(s);
      end;
      Dispose(Buff);
    end;
    List^.FreeAll;
    p:= New(PFileRec);
    p^.Name:= FName;
    List^.insert(p);
    close(d);
  end;
  MergeFiles:= ok;
end;


(********************************************************************)
(**                function CheckIfFilesAreThere                   **)
(********************************************************************)

procedure CheckIfFilesAreThere(var List: PFileNames; d: string);
var
  i: word;
  p: PFileRec;
  ss, dd, dest: PathStr;
  error: boolean;

  function GetName(n: PathStr): PathStr;
  var i: integer;
  begin
    i:= length(n);
    while n[i] <> '\' do dec(i);
    inc(i);
    GetName:= copy(n, i, length(n)+i+1);
  end;

  function GetPath(n: PAthStr): PathStr;
  var i: integer;
  begin
    i:= length(n);
    while n[i] <> '\' do dec(i);
    GetPath:= copy(n, 1, i);
  end;

  function IsThere(n: PathStr): boolean;
  var
    a: word;
    f: file;
  begin
    assign(f, n);
    getfattr(f, a);
    IsThere:= DosError = 0;
  end;

  function AddNum(var p: PathStr): boolean;
  var
    d: DirStr; n: NameStr; e: ExtStr;
    snum: string;
    num, code: integer;
    error: boolean;
  begin
    error:= false;
    FSplit(p, d, n, e);
    val(copy(n, length(n), 1), num, code);
    if code = 0 then
    begin
      val(copy(n, length(n)-1, 2), num, code);
      if code <> 0 then val(copy(n, length(n), 1), num, code);
    end else num:= 0;
    num:= num + 1;
    if num > 99 then error:= true else
    begin
      Str(num, snum);
      if length(n) <= ( 8 - length(snum) ) then
      begin
        if num = 1 then n:= n + snum else
          if num <= 10 then n:= copy(n, 1, length(n)-1) + snum else
            n:= copy(n, 1, length(n)-2) + snum;
      end else n:= copy(n, 1, 8 - length(snum)) + snum;
      p:= d + n + e;
    end;
    AddNum:= error;
  end;

begin
  for i:= 0 to List^.count-1 do
  begin
    error:= false;
    p:= PFileRec(List^.at(i));
    dest:= d + GetName(p^.Name);
    while (IsThere(dest)) and (not error) do error:= AddNum(dest);
    ss:= GetName(p^.Name);
    dd:= GetName(dest);
    if error then
    begin
       write(#7);
      OneStringRec:= PString(@ss);
              { 'Die Datei %s ist bereits 99 mal im Empfangsverzeichnis '+
                'vorhanden, und wird somit �berschrieben.' }
      ErrorBox(#3+GetString(1434), @OneStringRec, mfOkBeep);
    end;
    if (ss <> dd) and (not error) then
    begin
      AttentionBeep;
      TwoStringRec.s1:= PString(@ss);
      TwoStringRec.s2:= PString(@dd);
      if MessageBox(#3+GetString(1435), @TwoStringRec,
                    mfConfirmation+mfYesNoCancel) = cmYes then
      begin
        FRename(p^.Name, GetPath(p^.Name) + dd);
        p^.Name:= GetPath(p^.Name) + dd;
      end;
    end;
  end;
end;

end.