def2def.pas 2.3 KB

1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586878889909192939495969798
  1. PROGRAM def2def;
  2. { converts the rpoc section of a def file
  3. from function prototye format to function varaible format
  4. if not already in right form }
  5. VAR
  6. Fin, Fout : Text;
  7. I, J, K, L : Word;
  8. S, T, U, V : String;
  9. Mode : Word;
  10. PROCEDURE UpString(VAR S:String);
  11. VAR
  12. I : Word;
  13. BEGIN
  14. FOR I := 1 TO Length(S) DO
  15. S[I] := UpCase(S[I]);
  16. END;
  17. BEGIN
  18. IF ParamCount<>2 THEN
  19. BEGIN
  20. WriteLn('Error: Invalid parameter count');
  21. WriteLn('Usage:');
  22. WriteLn(' def2def [source] [destination]');
  23. Halt(1);
  24. END;
  25. IF ParamStr(1)=ParamStr(2) THEN
  26. BEGIN
  27. WriteLn('Error: files must be different');
  28. WriteLn('Usage:');
  29. WriteLn(' def2def [source] [destination]');
  30. Halt(1);
  31. END;
  32. Assign(Fin,ParamStr(1));
  33. Reset(Fin);
  34. Assign(Fout,ParamStr(2));
  35. ReWrite(Fout);
  36. WriteLn('Converting...');
  37. Mode := 0;
  38. WHILE Not(EOF(Fin)) DO
  39. BEGIN
  40. ReadLn(Fin,S);
  41. IF Length(S)>0 THEN
  42. IF S[1]='%' THEN
  43. BEGIN
  44. IF S='%END' THEN Mode:=0 ELSE
  45. IF S='%COPY_INTERFACE' THEN Mode:=1 ELSE
  46. IF S='%PROCS' THEN Mode:=2 ELSE
  47. (* Unknown *) Mode:=0;
  48. END ELSE
  49. BEGIN
  50. CASE Mode OF
  51. 0 : { nothing };
  52. 1 : { nothing };
  53. 2 : BEGIN
  54. T := S;
  55. WHILE Pos(' ',T)=1 DO
  56. Delete(T,1,1);
  57. I := Pos(' ',T);
  58. U := Copy(T,1,I-1);
  59. V := U;
  60. UpString(U);
  61. IF (U='PROCEDURE') OR (U='FUNCTION') THEN
  62. BEGIN
  63. { this line needs swapping }
  64. Delete(T,1,I);
  65. WHILE Pos(' ',T)=1 DO
  66. Delete(T,1,1);
  67. I := Pos('(',T);
  68. J := Pos(' ',T);
  69. K := Pos(':',T);
  70. L := Pos(';',T);
  71. IF L>0 THEN
  72. BEGIN
  73. IF (I>0) AND (I<L) THEN L := I;
  74. IF (J>0) AND (J<L) THEN L := J;
  75. IF (K>0) AND (K<L) THEN L := K;
  76. Insert(': '+V,T,L);
  77. S := T;
  78. END;
  79. END;
  80. END;
  81. ELSE { nothing };
  82. END;
  83. END;
  84. WriteLn(Fout,S);
  85. END;
  86. Close(Fin);
  87. Close(Fout);
  88. WriteLn('Done.');
  89. END.