git.oblomov.eu Git - ohcount/blob - test/src_dir/pascal1.pas

   1 {***************************************************************
   2  *
   3  * Unit Name: pndefs
   4  * Purpose  : Various Definitions and functions...
   5  * Author   : Simon Steele
   6  * Copyright: This Source Code is Copyright © 1998-2000 Echo
   7  *            Software and Simon Steele. Please read the license
   8  *                        agreement at www.pnotepad.org/press/psidx.html.
   9  **************************************************************}
  10 unit pndefs;
  11
  12 interface
  13
  14 uses SysUtils;
  15
  16 function CreatePNFile(filename : string; Text : pChar) : Boolean;
  17 function StripNewLines(aString: string): string;
  18 procedure ConvertTypes(filename : string);
  19
  20 const strFileTypes : PChar = ('.txt');
  21    strOpenTypes : PChar = ('%2|Text files (*.txt)|*.txt|0|0|0|LOG files (*.log)|*.log|0|0|0|Executable Files (*.exe, *.com, *.dll)|*.exe;*.com;*.dll|0|0|0');
  22    sepChar = '|';
  23    verChar = '%';
  24    CurrFileVer = '2';
  25
  26 implementation
  27
  28 function CreatePNFile(filename : string; Text : pChar) : Boolean;
  29 var F : TextFile;
  30 begin
  31    {$I-}
  32    AssignFile(F, filename);
  33    Rewrite(F);
  34    Write(F, Text);
  35    CloseFile(F);
  36    If IOResult <> 0 Then Result := False
  37                     Else Result := True;
  38    {$I+}
  39 end;
  40
  41 function StripNewLines(aString: string): string;
  42 var i : longint;
  43 begin
  44    result := '';
  45    i      := 1;
  46    while i <= length(aString) do
  47    begin
  48       if aString[i] = #13 then result := result + ' ' else
  49       if aString[i] <> #10 then result := result + aString[i];
  50       inc(i);
  51    end;
  52 end;
  53
  54 procedure ConvertTypes(filename : string);
  55 var t        : TextFile;
  56     s        : string;
  57     ps       : string; {part of string}
  58     Part     : integer;
  59     ipos     : integer;
  60     OutStr   : string;
  61 const Desc   = 1;
  62       Files  = 2;
  63       Parser = 3;
  64       Unix   = 4;
  65 begin
  66    // This assumes that it is being passed one of the old style type definition
  67    // files. We'll set the status on the main form to indicate this as well...
  68    OutStr := VerChar + CurrFileVer;
  69    if not fileexists(filename) then
  70    begin
  71       CreatePNFile(filename, strOpenTypes);
  72       exit;
  73    end;
  74    Assignfile(t, FileName);
  75    Reset(t);
  76    repeat
  77       Readln(t, s)
  78    until (Length(s) > 0) or EOF(t);
  79    CloseFile(t);
  80    if s = '' then Exit;
  81    part := Desc;
  82    repeat
  83       iPos := Pos(SepChar, s);
  84       if (iPos = 0) and (Length(s) > 0) then
  85       begin
  86          ps := s;
  87          s := '';
  88       end else
  89          ps := Copy(s, 1, ipos - 1);
  90       s := Copy(S, ipos + 1, Length(s));
  91       case part of
  92          Desc : begin
  93                   OutStr := OutStr + SepChar + ps;
  94                   part := Files;
  95                 end;
  96          Files : begin
  97                    OutStr := OutStr + SepChar + ps;
  98                    part := Parser;
  99                  end;
 100          Parser : begin
 101                     OutStr := OutStr + SepChar + ps + SepChar + '0' + SepChar + '0';
 102                     part := Desc;
 103                   end;
 104       end;
 105    until Length(s) < 1;
 106    Assignfile(t, filename);
 107    Rewrite(t);
 108    Write(t, OutStr);
 109    CloseFile(t);
 110 end;
 111
 112 end.