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

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