home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: Multimed / Multimed.zip / mp3osr05.zip / src / macroz.pas < prev    next >
Pascal/Delphi Source File  |  1999-12-08  |  12KB  |  475 lines
  1. {$F+}
  2. unit Macroz;
  3.  
  4. {
  5.  FastUUE Macros Engine
  6.  version 1.1
  7.  
  8.  1.1
  9.   + @length macro
  10.  
  11.  (c) by Sergey Korowkin, 1998.
  12. }
  13.  
  14. interface
  15. uses
  16.   Wizard;
  17.  
  18. const
  19.   mcSystem = 1;
  20.   mcUser = 2;
  21.  
  22. type
  23.   PMacros = ^TMacros;
  24.   TMacroFunction = procedure(M: PMacros; const Line: string);
  25.  
  26.   PString = ^string;
  27.  
  28.   PMacro = ^TMacro;
  29.   TMacro = object
  30.   public
  31.     ID, Data: PString;
  32.     ClassID: Byte;
  33.     IsFunc: Boolean;
  34.     Func: TMacroFunction;
  35.     constructor Init(AID: string; const AData: string; AClassID: Byte; AIsFunc: Boolean; AFunc: TMacroFunction);
  36.     destructor Done; virtual;
  37.   end;
  38.  
  39.   TMacros = object
  40.   public
  41.     EmptyLine: Boolean;
  42.  
  43.     constructor Init;
  44.     procedure AddMacro(const ID, Data: string; ClassID: Byte); virtual;
  45.     procedure AddFunction(const ID: string; Func: TMacroFunction; ClassID: Byte); virtual;
  46.     function GetMacro(ID: string): PMacro; virtual;
  47.     function GetMacroAndClass(ID: string; ClassID: Byte): PMacro; virtual;
  48.     procedure SetMacroData(M: PMacro; const NewData: string); virtual;
  49.     procedure RemoveMacro(const ID: string); virtual;
  50.     function Process(S: string): string; virtual;
  51.     function MacroProcess(const S: string): string; virtual;
  52.  
  53.     procedure AddAdditionalMacros; virtual;
  54.  
  55.     procedure ContainerInit; virtual;
  56.     function ContainerSize: LongInt; virtual;
  57.     function ContainerAt(Index: LongInt): PMacro; virtual;
  58.     procedure ContainerInsert(Macro: PMacro); virtual;
  59.     procedure ContainerFree(Macro: PMacro); virtual;
  60.     procedure ContainerDone; virtual;
  61.  
  62.     procedure Abstract;
  63.  
  64.     destructor Done; virtual;
  65.   end;
  66.  
  67. implementation
  68.  
  69. (* Default macros *)
  70.  
  71. procedure mcAssign(M: PMacros; const Line: string);
  72. begin
  73.   M^.AddMacro(ExtractWord(2, Line, [' ']), GetAllAfterSpace(Line, 2), mcUser);
  74. end;
  75.  
  76. procedure mcAddF(M: PMacros; const Line: string);
  77. var
  78.   S: string;
  79.   A: PMacro;
  80. begin
  81.   A := M^.GetMacroAndClass(ExtractWord(2, Line, [' ']), mcUser);
  82.   if A = nil then Exit;
  83.   M^.SetMacroData(A, GetPString(A^.Data) + GetAllAfterSpace(Line, 2));
  84. end;
  85.  
  86. procedure mcAddB(M: PMacros; const Line: string);
  87. var
  88.   S: string;
  89.   A: PMacro;
  90. begin
  91.   A := M^.GetMacroAndClass(ExtractWord(2, Line, [' ']), mcUser);
  92.   if A = nil then Exit;
  93.   S := GetPString(A^.Data);
  94.   M^.SetMacroData(A, GetAllAfterSpace(Line, 2) + GetPString(A^.Data));
  95. end;
  96.  
  97. procedure mcPad(M: PMacros; const Line: string);
  98. var
  99.   Count: LongInt;
  100.   A: PMacro;
  101. begin
  102.   A := M^.GetMacroAndClass(ExtractWord(2, Line, [' ']), mcUser);
  103.   if A = nil then Exit;
  104.   Str2LongInt(M^.MacroProcess(ExtractWord(3, Line, [' '])), Count);
  105.   M^.SetMacroData(A, Pad(Copy(M^.MacroProcess(GetPString(A^.Data)), 1, Count), Count));
  106. end;
  107.  
  108. procedure mcLPad(M: PMacros; const Line: string);
  109. var
  110.   Count: LongInt;
  111.   A: PMacro;
  112. begin
  113.   A := M^.GetMacroAndClass(ExtractWord(2, Line, [' ']), mcUser);
  114.   if A = nil then Exit;
  115.   Str2LongInt(M^.MacroProcess(ExtractWord(3, Line, [' '])), Count);
  116.   M^.SetMacroData(A, LeftPad(Copy(M^.MacroProcess(GetPString(A^.Data)), 1, Count), Count));
  117. end;
  118.  
  119. procedure mcPadCh(M: PMacros; const Line: string);
  120. var
  121.   Count: LongInt;
  122.   CH: Char;
  123.   A: PMacro;
  124. begin
  125.   A := M^.GetMacroAndClass(ExtractWord(2, Line, [' ']), mcUser);
  126.   if A = nil then Exit;
  127.   Str2LongInt(M^.MacroProcess(ExtractWord(3, Line, [' '])), Count);
  128.   CH := Str2Char(M^.MacroProcess(ExtractWord(4, Line, [' '])));
  129.   M^.SetMacroData(A, PadCh(Copy(M^.MacroProcess(GetPString(A^.Data)), 1, Count), CH, Count));
  130. end;
  131.  
  132. procedure mcLPadCh(M: PMacros; const Line: string);
  133. var
  134.   Count: LongInt;
  135.   CH: Char;
  136.   A: PMacro;
  137. begin
  138.   A := M^.GetMacroAndClass(ExtractWord(2, Line, [' ']), mcUser);
  139.   if A = nil then Exit;
  140.   Str2LongInt(M^.MacroProcess(ExtractWord(3, Line, [' '])), Count);
  141.   CH := Str2Char(M^.MacroProcess(ExtractWord(4, Line, [' '])));
  142.   M^.SetMacroData(A, LeftPadCh(Copy(M^.MacroProcess(GetPString(A^.Data)), 1, Count), CH, Count));
  143. end;
  144.  
  145. procedure mcCopy(M: PMacros; const Line: string);
  146. var
  147.   S1, S2: LongInt;
  148.   A: PMacro;
  149. begin
  150.   A := M^.GetMacroAndClass(ExtractWord(2, Line, [' ']), mcUser);
  151.   if A = nil then Exit;
  152.   Str2LongInt(M^.MacroProcess(ExtractWord(3, Line, [' '])), S1);
  153.   Str2LongInt(M^.MacroProcess(ExtractWord(4, Line, [' '])), S2);
  154.   M^.SetMacroData(A, Copy(M^.MacroProcess(GetPString(A^.Data)), S1, S2));
  155. end;
  156.  
  157. procedure mcCenter(M: PMacros; const Line: string);
  158. var
  159.   Count: LongInt;
  160.   A: PMacro;
  161. begin
  162.   A := M^.GetMacroAndClass(ExtractWord(2, Line, [' ']), mcUser);
  163.   if A = nil then Exit;
  164.   Str2LongInt(M^.MacroProcess(ExtractWord(3, Line, [' '])), Count);
  165.   M^.SetMacroData(A, Center(Copy(M^.MacroProcess(GetPString(A^.Data)), 1, Count), Count));
  166. end;
  167.  
  168. procedure mcCenterCh(M: PMacros; const Line: string);
  169. var
  170.   Count: LongInt;
  171.   CH: Char;
  172.   A: PMacro;
  173. begin
  174.   A := M^.GetMacroAndClass(ExtractWord(2, Line, [' ']), mcUser);
  175.   if A = nil then Exit;
  176.   Str2LongInt(M^.MacroProcess(ExtractWord(3, Line, [' '])), Count);
  177.   CH := Str2Char(M^.MacroProcess(ExtractWord(4, Line, [' '])));
  178.   M^.SetMacroData(A, CenterCh(Copy(M^.MacroProcess(GetPString(A^.Data)), 1, Count), CH, Count));
  179. end;
  180.  
  181. procedure mcScale(M: PMacros; const Line: string);
  182. var
  183.   A: PMacro;
  184.   Cur, Max, Need: LongInt;
  185. begin
  186.   A := M^.GetMacroAndClass(ExtractWord(2, Line, [' ']), mcUser);
  187.   if A = nil then Exit;
  188.   Str2LongInt(M^.MacroProcess(ExtractWord(3, Line, [' '])), Cur);
  189.   Str2LongInt(M^.MacroProcess(ExtractWord(4, Line, [' '])), Max);
  190.   Str2LongInt(M^.MacroProcess(ExtractWord(5, Line, [' '])), Need);
  191.   if Max = 0 then Max := 1;
  192.   M^.SetMacroData(A, Long2Str(Round(Cur / Max * Need)));
  193. end;
  194.  
  195. procedure mcNumFormat(M: PMacros; const Line: string);
  196. var
  197.   A: PMacro;
  198.   K: LongInt;
  199. begin
  200.   A := M^.GetMacroAndClass(ExtractWord(2, Line, [' ']), mcUser);
  201.   if A = nil then Exit;
  202.   Str2LongInt(M^.MacroProcess(ExtractWord(2, Line, [' '])), K);
  203.   M^.SetMacroData(A, Long2StrFmt(K));
  204. end;
  205.  
  206. procedure mcConvSize(M: PMacros; const Line: string);
  207. var
  208.   A: PMacro;
  209.   K: LongInt;
  210.   Z: LongInt;
  211.   S: string;
  212. begin
  213.   A := M^.GetMacroAndClass(ExtractWord(2, Line, [' ']), mcUser);
  214.   if A = nil then Exit;
  215.   Str2LongInt(M^.MacroProcess(ExtractWord(2, Line, [' '])), K);
  216.   Str2LongInt(M^.MacroProcess(ExtractWord(3, Line, [' '])), Z);
  217.   S := Long2StrFmt(K) + 'b';
  218.   if Length(S) > Z then S := Long2StrFmt(K div 1024) + 'K';
  219.   if Length(S) > Z then S := Long2StrFmt(K div 1024 div 1024) + 'M';
  220.   if Length(S) > Z then S := Long2StrFmt(K div 1024 div 1024 div 1024) + 'G';
  221.   M^.SetMacroData(A, S);
  222. end;
  223.  
  224. procedure mcLength(M: PMacros; const Line: string);
  225. var
  226.   A: PMacro;
  227.   K: LongInt;
  228.   Z: LongInt;
  229.   S: string;
  230. begin
  231.   A := M^.GetMacroAndClass(ExtractWord(2, Line, [' ']), mcUser);
  232.   if A = nil then Exit;
  233.   S := M^.MacroProcess(GetAllAfterSpace(Line, 2));
  234.   M^.SetMacroData(A, Long2Str(Length(S)));
  235. end;
  236.  
  237. procedure mcDestroy(M: PMacros; const Line: string);
  238. begin
  239.   M^.RemoveMacro(ExtractWord(2, Line, [' ']));
  240. end;
  241.  
  242. (* Service functions *)
  243.  
  244. function NewStr(const S: string): PString;
  245. var
  246.   P: PString;
  247. begin
  248.   if S = '' then
  249.     P := nil
  250.   else
  251.   begin
  252.     GetMem(P, Length(S) + 1);
  253.     P^ := S;
  254.   end;
  255.   NewStr := P;
  256. end;
  257.  
  258. procedure DisposeStr(P: PString);
  259. begin
  260.   if P <> nil then FreeMem(P, Length(P^) + 1);
  261. end;
  262.  
  263. (* TMacro methods *)
  264.  
  265. constructor TMacro.Init(AID: string; const AData: string; AClassID: Byte; AIsFunc: Boolean; AFunc: TMacroFunction);
  266. begin
  267.   StUpcaseEx(AID);
  268.   TrimEx(AID);
  269.   ID := NewStr(AID);
  270.   Data := NewStr(AData);
  271.   IsFunc := AIsFunc;
  272.   Func := AFunc;
  273.   ClassID := AClassID;
  274. end;
  275.  
  276. destructor TMacro.Done;
  277. begin
  278.   DisposeStr(ID);
  279.   DisposeStr(Data);
  280. end;
  281.  
  282. (* TMacros methods *)
  283.  
  284. constructor TMacros.Init;
  285. begin
  286.   ContainerInit;
  287.   AddMacro('@nothing', '', mcUser);
  288.   AddFunction('@assign', mcAssign, mcSystem);
  289.   AddFunction('@destroy', mcDestroy, mcSystem);
  290.   AddFunction('@addb', mcAddB, mcSystem);
  291.   AddFunction('@addf', mcAddF, mcSystem);
  292.   AddFunction('@pad', mcPad, mcSystem);
  293.   AddFunction('@padch', mcPadCh, mcSystem);
  294.   AddFunction('@leftpad', mcLPad, mcSystem);
  295.   AddFunction('@leftpadch', mcLPadCh, mcSystem);
  296.   AddFunction('@copy', mcCopy, mcSystem);
  297.   AddFunction('@centerch', mcCenterCh, mcSystem);
  298.   AddFunction('@center', mcCenter, mcSystem);
  299.   AddFunction('@scale', mcScale, mcSystem);
  300.   AddFunction('@numformat', mcNumFormat, mcSystem);
  301.   AddFunction('@convsize', mcConvSize, mcSystem);
  302.   AddFunction('@length', mcLength, mcSystem);
  303.   AddAdditionalMacros;
  304. end;
  305.  
  306. procedure TMacros.AddMacro(const ID, Data: string; ClassID: Byte);
  307. var
  308.   M: PMacro;
  309. begin
  310.   RemoveMacro(ID);
  311.   M := New(PMacro, Init(ID, Data, ClassID, False, nil));
  312.   ContainerInsert(M);
  313. end;
  314.  
  315. procedure TMacros.AddFunction(const ID: string; Func: TMacroFunction; ClassID: Byte);
  316. var
  317.   M: PMacro;
  318. begin
  319.   RemoveMacro(ID);
  320.   M := New(PMacro, Init(ID, '', ClassID, True, Func));
  321.   ContainerInsert(M);
  322. end;
  323.  
  324. function TMacros.GetMacro(ID: string): PMacro;
  325. var
  326.   K: LongInt;
  327. begin
  328.   TrimEx(ID);
  329.   StUpcaseEx(ID);
  330.   for K := 1 to ContainerSize do
  331.     if GetPString(ContainerAt(K)^.ID) = ID then
  332.     begin
  333.       GetMacro := ContainerAt(K);
  334.       Exit;
  335.     end;
  336.   GetMacro := nil;
  337. end;
  338.  
  339. function TMacros.GetMacroAndClass(ID: string; ClassID: Byte): PMacro;
  340. var
  341.   K: LongInt;
  342.   M: PMacro;
  343. begin
  344.   TrimEx(ID);
  345.   StUpcaseEx(ID);
  346.   for K := 1 to ContainerSize do
  347.   begin
  348.     M := ContainerAt(K);
  349.     if (GetPString(M^.ID) = ID) and (M^.ClassID = ClassID) then
  350.     begin
  351.       GetMacroAndClass := M;
  352.       Exit;
  353.     end;
  354.   end;
  355.   GetMacroAndClass := nil;
  356. end;
  357.  
  358. procedure TMacros.SetMacroData(M: PMacro; const NewData: string);
  359. begin
  360.   if M = nil then Exit;
  361.   DisposeStr(M^.Data);
  362.   M^.Data := NewStr(NewData);
  363. end;
  364.  
  365. procedure TMacros.RemoveMacro(const ID: string);
  366. var
  367.   M: PMacro;
  368. begin
  369.   M := GetMacro(ID);
  370.   if M = nil then Exit;
  371.   ContainerFree(M);
  372. end;
  373.  
  374. function TMacros.Process(S: string): string;
  375. var
  376.   C: string;
  377.   O: string;
  378.   M: PMacro;
  379.   K: LongInt;
  380.   Ok: Boolean;
  381. begin
  382.   C := ExtractWord(1, S, [' ']);
  383.   TrimEx(C);
  384.   StUpcaseEx(C);
  385.   if (Str2Char(C) = '@') and (GetMacroAndClass(C, mcSystem) <> nil) then
  386.   begin
  387.     EmptyLine := True;
  388.     Process := '';
  389.     M := GetMacroAndClass(C, mcSystem);
  390.     if M^.IsFunc then
  391.       M^.Func(@Self, Ltrim(S));
  392.     Exit;
  393.   end;
  394.   EmptyLine := False;
  395.   repeat
  396.     Ok := True;
  397.     for K := 1 to ContainerSize do
  398.     begin
  399.       M := ContainerAt(K);
  400.       if (M^.IsFunc) or (M^.ClassID <> mcUser) then Continue;
  401.       ReplaceEx(S, GetPString(M^.ID), GetPString(M^.Data));
  402.       if Replaced then
  403.         Ok := False;
  404.     end;
  405.   until Ok;
  406.   Process := S;
  407. end;
  408.  
  409. function TMacros.MacroProcess(const S: string): string;
  410. var
  411.   OldEmptyLine: Boolean;
  412. begin
  413.   OldEmptyLine := EmptyLine;
  414.   MacroProcess := Process(S);
  415.   EmptyLine := OldEmptyLine;
  416. end;
  417.  
  418. procedure TMacros.AddAdditionalMacros;
  419. begin
  420.    {var
  421.    Day, Month, Year, Hour, Min, Sec, Dow: Word;
  422.    IWannaTime(Hour, Min, Sec);
  423.    IWannaDate(Day, Month, Year);
  424.    Dow:=DayOfWeek(Year, Month, Day);
  425.    AddMacro('@curhour', LeftPadCh(Long2Str(Hour), '0', 2), mcUser);
  426.    AddMacro('@curmin', LeftPadCh(Long2Str(Min), '0', 2), mcUser);
  427.    AddMacro('@cursec', LeftPadCh(Long2Str(Sec), '0', 2), mcUser);
  428.    AddMacro('@curday', LeftPadCh(Long2Str(Day), '0', 2), mcUser);
  429.    AddMacro('@curmonth', LeftPadCh(Long2Str(Month), '0', 2), mcUser);
  430.    AddMacro('@curyear', LeftPadCh(Long2Str(Year), '0', 2), mcUser);
  431.    AddMacro('@curdow', GetDow(Dow), mcUser);
  432.    AddMacro('@curshortdow', GetShortDow(Dow), mcUser);}
  433. end;
  434.  
  435. procedure TMacros.ContainerInit;
  436. begin
  437.   Abstract;
  438. end;
  439.  
  440. function TMacros.ContainerSize: LongInt;
  441. begin
  442.   Abstract;
  443. end;
  444.  
  445. function TMacros.ContainerAt(Index: LongInt): PMacro;
  446. begin
  447.   Abstract;
  448. end;
  449.  
  450. procedure TMacros.ContainerInsert(Macro: PMacro);
  451. begin
  452.   Abstract;
  453. end;
  454.  
  455. procedure TMacros.ContainerFree(Macro: PMacro);
  456. begin
  457.   Abstract;
  458. end;
  459.  
  460. procedure TMacros.ContainerDone;
  461. begin
  462.   Abstract;
  463. end;
  464.  
  465. procedure TMacros.Abstract;
  466. begin
  467.   RunError(217);
  468. end;
  469.  
  470. destructor TMacros.Done;
  471. begin
  472.   ContainerDone;
  473. end;
  474.  
  475. end.