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

   1 unit pndefs;
   2 interface
   3 uses SysUtils;
   4 function CreatePNFile(filename : string; Text : pChar) : Boolean;
   5 function StripNewLines(aString: string): string;
   6 procedure ConvertTypes(filename : string);
   7 const strFileTypes : PChar = ('.txt');
   8 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');
   9 sepChar = '|';
  10 verChar = '%';
  11 CurrFileVer = '2';
  12 implementation
  13 function CreatePNFile(filename : string; Text : pChar) : Boolean;
  14 var F : TextFile;
  15 begin
  16 AssignFile(F, filename);
  17 Rewrite(F);
  18 Write(F, Text);
  19 CloseFile(F);
  20 If IOResult <> 0 Then Result := False
  21 Else Result := True;
  22 end;
  23 function StripNewLines(aString: string): string;
  24 var i : longint;
  25 begin
  26 result := '';
  27 i      := 1;
  28 while i <= length(aString) do
  29 begin
  30 if aString[i] = #13 then result := result + ' ' else
  31 if aString[i] <> #10 then result := result + aString[i];
  32 inc(i);
  33 end;
  34 end;
  35 procedure ConvertTypes(filename : string);
  36 var t        : TextFile;
  37 s        : string;
  38 ps       : string; {part of string}
  39 Part     : integer;
  40 ipos     : integer;
  41 OutStr   : string;
  42 const Desc   = 1;
  43 Files  = 2;
  44 Parser = 3;
  45 Unix   = 4;
  46 begin
  47 OutStr := VerChar + CurrFileVer;
  48 if not fileexists(filename) then
  49 begin
  50 CreatePNFile(filename, strOpenTypes);
  51 exit;
  52 end;
  53 Assignfile(t, FileName);
  54 Reset(t);
  55 repeat
  56 Readln(t, s)
  57 until (Length(s) > 0) or EOF(t);
  58 CloseFile(t);
  59 if s = '' then Exit;
  60 part := Desc;
  61 repeat
  62 iPos := Pos(SepChar, s);
  63 if (iPos = 0) and (Length(s) > 0) then
  64 begin
  65 ps := s;
  66 s := '';
  67 end else
  68 ps := Copy(s, 1, ipos - 1);
  69 s := Copy(S, ipos + 1, Length(s));
  70 case part of
  71 Desc : begin
  72 OutStr := OutStr + SepChar + ps;
  73 part := Files;
  74 end;
  75 Files : begin
  76 OutStr := OutStr + SepChar + ps;
  77 part := Parser;
  78 end;
  79 Parser : begin
  80 OutStr := OutStr + SepChar + ps + SepChar + '0' + SepChar + '0';
  81 part := Desc;
  82 end;
  83 end;
  84 until Length(s) < 1;
  85 Assignfile(t, filename);
  86 Rewrite(t);
  87 Write(t, OutStr);
  88 CloseFile(t);
  89 end;
  90 end.