[Back to MAIL SWAG index] [Back to Main SWAG index] [Original]
Program Sig;
{ Description: This is a little program which I wrote whose sole purpose }
{ in life is to add signature lines to messages written in }
{ an offline mail reader. The program scans a text file for}
{ instances of /SIGx (where x is a number) and replaces them}
{ with signature number x from a configuration file. }
{ Requires: USEFULL.PAS written by me. Email me if you don't have it.}
{ ACOLOR.INC written by me. Email me if you don't have it.}
{ NOTE : they are Attached at the end of this unit }
{ Created: March 1995 }
{ Author: Tobin Fricke (tobin@mail.edm.net) }
{ If you use this, I'd appreciate it if you could send me a postcard }
{ from where you live, or at least send me an email. My email address }
{ is tobin@mail.edm.net. If that doesn't work, try using }
{ fricke@roboben.engr.ucdavis.edu. My postal address is: }
{ 25001 El Cortijo Ln., Mission Viejo, CA 92691-5236, USA. Thanks! }
{
; CyberSig configuration file example:
@1
ÚÄÄÄÄÄÄÄÄÄÄÄ¿
³ Light Ray ³
ÀÄÄÄÄÄÄÄÄÄÄÄÙ
@2
Tobin T. Fricke
TobinTech Engineering
dr261@cleveland.freenet.edu
}
Uses CRT, Usefull;
Const MyVersion='1.00';
{$I ACOLOR.INC}
Procedure Process(Config,Filename:String);
Const ConfigF=0; InputF=1; OutputF=2;
Var F:Array[0..2] of Text;
N,S,W,Q:String;
B:Byte;
Rep:Boolean;
begin
Assign(F[ConfigF],Config);
Assign(F[InputF],Filename);
N:=TempFile('');
Rename(F[InputF],N);
Reset(F[InputF]);
Assign(F[OutputF],Filename);
Rewrite(F[OutputF]);
Repeat
Readln(F[InputF],S);
If Pos('/SIG',UPSTRING(S))=1
then
begin
Write(' `Bþ`3 Found '+S);
Rep:=False;
Reset(F[ConfigF]);
B:=0;
Repeat
Readln(F[ConfigF],W);
If W[1]<>';' then
begin
If W[1]='@' then B:=Val(del(W,1,1))
else
begin
Q:=UpString('/SIG'+Str(B));
if Q=UpString(S) then
begin
System.Writeln(F[OutputF],W);
Rep:=True;
end;
end;
end;
Until EOF(F[ConfigF]);
If Rep then Writeln(', Replaced with signature') else
Writeln(', Signature not found in config file');
Close(F[ConfigF]);
end
else
System.Writeln(F[OutputF],S);
Until EOF(F[InputF]);
Close(F[InputF]);
Close(F[OutputF]);
Erase(F[InputF]);
Rename(F[OutputF],Filename);
end;
Begin
clrScr;
Writeln(' `4Cy`Cbe`FrSig Signature App`Cli`4er`8,`7 Version `F'+MyVersion+'`7');
Writeln(' `9Copyright `1(`9C`1)`9 1995 by Tobin T`1.`9 Fricke`1,`9 All Rights Reserved`1.`7 ');
Writeln(' `3Created At the `2Di`AGi`FTAL Fo`ARE`2ST `3(`B714`3)`B 586`3-`B6142 `928800`1bps`7');
If (ParamCount<>2) or
(Not FileExists(ParamStr(1))) or
(Not FileExists(ParamStr(2)))
then
begin
Writeln(' `EUSAGE: `F'+ParamStr(0)+' `8(`7CONFIG FILE`8) (`7FILENAME`8)`7');
Writeln(' `8(`7CONFIG FILE`8) `3is the complete path and filename of your config file. ');
Writeln(' `8(`7FILENAME`8) `3is the complete path and filename of the message file to process. ');
If ParamCount=2 then
begin
If Not FileExists(ParamStr(1)) then Writeln(' `B Cannot find '+paramStr(1));
If Not FileExists(ParamStr(2)) then Writeln(' `B Cannot find '+paramStr(2));
end;
end;
Process(ParamStr(1),ParamStr(2));
End.
{ ------------------- ACOLOR.INC ... CUT ---------}
{ Description: These routines allow one to embed color codes into strings }
{ and have them print out nicely. The format is ` followed }
{ by a character from 0 to 9, A to O, X or Y which represents}
{ the color. }
{ Filename: ACOLOR.INC }
{ Date: March 1995 }
{ Author: Tobin Fricke }
{ If you use this, I'd appreciate it if you could send me a postcard }
{ from where you live, or at least send me an email. My email address }
{ is tobin@mail.edm.net. If that doesn't work, try using }
{ fricke@roboben.engr.ucdavis.edu. My postal address is: }
{ 25001 El Cortijo Ln., Mission Viejo, CA 92691-5236, USA. Thanks! }
Procedure Write(S:String);
begin
Repeat
If S[1]='`' then
begin
S[2]:=UpCase(S[2]);
If S[2] IN ['0'..'9','A'..'O','X','Y'] then
Begin
If S[2] IN ['0'..'9'] then TextColor(Ord(S[2])-48);
IF S[2] IN ['A'..'F'] then TextColor(Ord(S[2])-55);
IF S[2] IN ['G'..'O'] then TextBackground(Ord(S[2])-71);
IF S[2]='X' then if (TextAttr AND 128)=0 then TextAttr:=TextAttr+128;
IF S[2]='Y' then if (TextAttr AND 128)=128 then TextAttr:=TextAttr-128;
Delete(S,1,2);
End;
end
else
begin
System.Write(S[1]);
Delete(S,1,1);
end;
Until S='';
end;
Procedure Writeln(S:String);
begin
Write(S+#10+#13);
end;
Function RandomCase(S:String):String;
Var B:Byte;
begin
For B:=1 to Length(S) do
if random>0.5 then S[B]:=LoCase(S[B]) else S[B]:=UpCase(S[B]);
RandomCase:=S;
end;
Function RandomColor(S:String):String;
var B:Byte;
begin
For B:=Length(S) downto 1 do
if Random>0.5 then Insert('`3',S,B) else Insert('`B',S,B);
RandomColor:=S;
end;
Function RainBow(S:String;A:Byte):String;
Begin
If A<Length(S) then Insert('`8',S,A+3);
If A<=Length(S) then Insert('`7',S,A+2);
Insert('`F',S,A+1);
Insert('`7',S,A);
Insert('`8',S,0);
S:=S+' ';
Rainbow:=S;
End;
{------------------ CUT ---------------------}
Unit Usefull;
{ Copyright (C) 1995 by Tobin T. Fricke, All Rights Reserved }
{ Use this and have fun, but tell me first. BBS 714-586-6142 }
{ Make sure to mention that you used this in your documentation of your }
{ program(s) if you do use it. Thanks. }
{ I didn't write all of the routines, but I wrote most of them. }
{ If you use this, I'd appreciate it if you could send me a postcard }
{ from where you live, or at least send me an email. My email address }
{ is tobin@mail.edm.net. If that doesn't work, try using }
{ fricke@roboben.engr.ucdavis.edu. My postal address is: }
{ 25001 El Cortijo Ln., Mission Viejo, CA 92691-5236, USA. Thanks! }
{ Updated May 1995 }
Interface
{$IFDEF WINDOWS}
type
{ Date & time recored used by PackTime }
{ and UnpackTime }
DateTime = record
Year,Month,Day,Hour,Min,Sec: Word;
end;
{$ENDIF}
Type MIDRecord = Record
InfoLevel : Word;
SerialNum : LongInt; {This is the serial number...}
VolLabel : Array[1..11] of Char;
FatType : Array[1..8] of Char;
End;
{$IFNDEF OS2} Function Label_Fat(Var Mid : MidRecord; Drive : Word) : Boolean;
{$ENDIF}
Function LongToHex(L:Longint):String;
Function Center(S:String; B:Byte):String;
{Center returns a S, centered with spaces, of length B }
Function Left(S:String; B:Byte):String;
{ returns a Left-Justied string, length B }
Function PadRight(S:String; B:Byte; C:Char):String;
{ returns S padded with B of C on the Right }
Function Right(S:String; B:Byte):String;
{ same as Left, but right-justifies }
function FileExists(FileName: String): Boolean;
{ does Filename Exist? }
Function UpString(S:String):String;
{ Returns S in upper case }
Function LoString(S:String):String;
{ Returns S in lower case }
Function LoCase(C:Char):Char;
{ Returns C in lower case }
Function Str(X:integer):String;
{ Converts X to a string }
Function Strw(X:Word):String;
{ Convert a Word to a String }
Function Strl(X:LongInt):String;
Function StrR(X:Real):String;
Function WhatDir:String;
Function Val(S:String):Integer;
Function ValW(S:String):Word;
Function ValL(S:String):longint;
Function Rep(S:String; C:Word):String;
Function TempFile( Path: STRING ): STRING;
Function SizeOfFile(S:String):LongInt;
Function NameCaps(S:String):String;
{ Capitalize The First Letter Of Each Word }
Function Del(S:String; Index: Integer; Count:Integer):String;
{ Delete, but as a function }
Function Strip_(S:String):String;
{ Changes _'s to spaces }
Function ActualFileSize:LongInt;
{ How big is your EXE? }
Procedure Lines(S:String);
Procedure Lines50; { Go into 50 lines-mode}
Procedure Lines25;
Procedure Lines35;
{$IFNDEF OS2}
Function NetworkDrive(Drive:Char):Boolean;
{$ENDIF}
Function StrBool(S:String):Boolean;
Procedure SwapStr(Var A,B:String);
{ Swaps A and B: C=A; A=B; B=C; }
Procedure ConvertBase(BaseN:Byte; BaseNNumber:String;
BaseZ:Byte; var BaseZNumber:String);
{ Converts base 2-36 to base 2-36 }
Function WordWrap(S:String; Var Remainder:String; Len:Byte):String;
{ Tobin's wonder-word-wrap. }
Function AN(S:String):String;
{ prepends "a " or "an " to S, based on the first letter }
Function LastDrive: Char;
var UError:Word;
Implementation
{$IFDEF WINDOWS}
Uses WinCRT, WinDOS;
{$ELSE}
Uses CRT, DOS;
{$ENDIF}
{$IFNDEF OS2}
Function Label_Fat(Var Mid : MidRecord; Drive : Word) : Boolean;
Var Result : Word;
Var Regs : Registers;
Begin
FillChar(Mid,SizeOf(Mid),0);
FillChar(Regs,SizeOf(Regs),0);
With Regs DO
Begin
AX := $440D;
BX := Drive;
CX := $0866;
DS := Seg(Mid);
DX := Ofs(Mid);
Intr($21,Regs);
Case AX of
$01 : Label_Fat := False;
$02 : Label_Fat := False;
$05 : Label_Fat := False;
Else Label_Fat := True;
End;
End;
End;
{$ENDIF}
(*
Var Mid : MidRecord;
Begin
ClrScr;
If Label_Fat(Mid,0) Then
With Mid DO
Begin
Writeln(SerialNum);
Writeln(VolLabel);
Writeln(FatType);
End
Else Writeln('Error Occured');
End.
*)
Procedure ConvertBase(BaseN:Byte; BaseNNumber:String;
BaseZ:Byte; var BaseZNumber:String);
var
I: Integer;
Number,Remainder: LongInt;
begin
Number := 0;
for I := 1 to Length (BaseNNumber) do
case BaseNNumber[I] of
'0'..'9': Number := Number * BaseN + Ord (BasenNumber[I]) - Ord ('0');
'A'..'Z': Number := Number * BaseN + Ord (BasenNumber[I]) -
Ord ('A') + 10;
'a'..'z': Number := Number * BaseN + Ord (BasenNumber[I]) -
Ord ('a') + 10;
end; BaseZNumber := ''; while Number > 0 do
begin
Remainder := Number mod BaseZ;
Number := Number div BaseZ;
case Remainder of
0..9: BaseZNumber := Char (Remainder + Ord ('0')) + BaseZNumber;
10..36: BaseZNumber := Char (Remainder - 10 + Ord ('A')) + BaseZNumber;
end;
end; end;
Procedure SwapStr(Var A,B:String);
var C:String;
begin
C:=A;
A:=B;
B:=C;
end;
{$IFDEF XXX}
Type Registers = record
case Integer of
0: (AX,BX,CX,DX,BP,SI,DI,DS,ES,Flags: Word);
1: (AL,AH,BL,BH,CL,CH,DL,DH: Byte);
end;
{$ENDIF}
{$IFNDEF OS2}
FUNCTION NetworkDrive (Drive:CHAR):BOOLEAN;
{$Ifdef windows} var reg:Tregisters; {$else} var Reg:Registers; {$endif}
var DosErrorCode:Word;
BEGIN
Drive := UpCase (Drive); { Drive _must_ be 'A'..'Z' }
IF (Drive IN ['A'..'Z']) THEN BEGIN { make sure of 'A'..'Z' }
Reg.BL := ORD(Drive) - 64; { 1 = A:, 2 = B:, 3 = C: etc. }
Reg.AX := $4409; { Dos fn: check if dev remote }
MsDos (Reg); { call Dos' services }
IF ODD(Reg.FLAGS) THEN { Dos reports function error? }
DosErrorCode := Reg.AX { yes: return Dos' error code }
ELSE BEGIN { else ... }
DosErrorCode := 0; { 0 = no error was detected }
IF ODD(Reg.DX SHR 12) THEN { is Drive remote? }
NetworkDrive := TRUE { yes: return TRUE }
ELSE
NetworkDrive := FALSE; { no: return FALSE }
{END IF ODD(Reg.DX...}
END; {IF ODD(Reg.FLAGS)}
END; {IF Drive}
END {NetworkDrive};
{$ENDIF}
Function SizeofFile(S:String):LongInt;
var F:File;
begin
Assign(F,S);
FileMode:=0;
Reset(F,1);
SizeOfFile:=FileSize(F);
Close(F);
end;
Function ActualFileSize:LongInt;
var F:File;
begin
ActualFileSize:=SizeOfFile(ParamStr(0));
end;
Procedure Lines50; Assembler;
ASM
MOV AH, 11H
MOV AL, 12H
MOV BL, 0
INT 10H
END;
Procedure Lines25; Assembler;
ASM
MOV AH, 11H
MOV AL, 14H
MOV BL, 0
INT 10H
END;
Procedure Lines35; Assembler;
ASM
MOV AH, 11H
MOV AL, 11H
MOV BL, 0
INT 10H
END;
Procedure Lines(S:String);
Begin
If Val(S)=50 then Lines50;
If Val(S)=25 then Lines25;
If Val(S)=35 then Lines35;
End;
Function Strip_(S:String):String;
var B:Byte;
begin
For B:=1 to length(S) do if S[B]='_' then S[B]:=' ';
Strip_:=S;
end;
Function Del(S:String; Index:Integer; Count:Integer):String;
begin
Delete(S,Index,Count);
Del:=S;
end;
Function WhatDir:String;
var s:String;
begin
GetDir(0,s);
whatdir:=s;
end;
Function Str(X:integer):String;
var S:String;
Begin
System.Str(X,S);
Str:=S;
End;
Function StrL(X:LongInt):String;
var S:String;
Begin
System.Str(X,S);
StrL:=S;
End;
Function StrW(X:word):String;
var S:String;
Begin
System.Str(X,S);
StrW:=S;
End;
Function StrR(X:Real):String;
var S:String;
Begin
System.Str(X,S);
StrR:=S;
End;
Function Val(S:String):Integer;
var A,B:Integer;
begin
System.Val(S,A,B);
If B=0 then Val:=A else begin Val:=0; UError:=B; End;
end;
Function ValW(S:String):Word;
var B:Integer;
A:Word;
begin
System.Val(S,A,B);
If B=0 then ValW:=A else begin ValW:=0; UError:=B; End;
end;
Function ValL(S:String):longint;
var B:integer;
A:longint;
begin
System.Val(S,A,B);
If B=0 then Vall:=A else begin Vall:=0; UError:=B; End;
end;
Function Upstring(S:String):String;
var
I:Byte;
begin
for i := 1 to Length(s) do s[i] := UpCase(s[i]);
Upstring:=S;
end;
Function LoCase(C:Char):Char;
begin
If (Ord(C)>64) and (Ord(C)<91) then
LoCase:=Char(Ord(C)+32)
else LoCase:=C;
end;
Function LoString(S:String):String;
var
I:Byte;
begin
for i := 1 to Length(s) do s[i] := LoCase(s[i]);
Lostring:=S;
end;
Function NameCaps(S:String):String;
var I:byte;
begin
S:=LoString(S);
S[1]:=UpCase(S[1]);
For I:=1 to Length(S) do
If S[I]=' ' then
if I<Length(S) then S[I+1]:=UpCase(S[I+1]);
namecaps:=s;
end;
function FileExists(FileName: String): Boolean;
{ Boolean function that returns True if the file exists;otherwise,
it returns False. Closes the file if it exists. }
var
F: file;
begin
{$I-}
Filemode:=0;
Assign(F, FileName);
FileMode := 0; {( Set file access to read only }
Reset(F);
Close(F);
{$I+}
FileExists := (IOResult = 0) and (FileName <> '');
end; { FileExists }
Function Center(S:String; B:Byte):String;
var A:Byte;
Begin
Repeat
A:=Length(S) div 2;
If A<(B Div 2) then S:=' '+S+' ';
Until (Length(S) div 2)>=((B) Div 2);
If Length(S)<B then S:=S+' ';
Center:=S;
End;
Function Left(S:String; B:Byte):String;
var A:Byte;
Begin
Repeat
A:=Length(S);
If A<B then S:=S+' ';
Until Length(S)>=((B));
While Length(S)>B do Delete(S,Length(S),1);
Left:=S;
End;
Function PadRight(S:String; B:Byte; C:Char):String;
var A:Byte;
Begin
Repeat
A:=Length(S);
If A<B then S:=C+S;
Until (Length(S)>=(B));
PadRight:=S;
End;
Function Right(S:String; B:Byte):String;
Begin
Right:=PadRight(S,B,' ');
End;
Function Rep(S:String; C:Word):String;
var W:Word;
T:String;
begin
T:='';
For W:=1 to C do T:=T+S;
Rep:=T;
end;
Function StrBool(S:String):Boolean;
begin
S:=UpString(S);
StrBool:=(Pos('T',S)>0);
end;
FUNCTION TempFile( Path: STRING ): STRING;
VAR
{$IFDEF WINDOWS}
DateStr : TDateTime;
{$ELSE}
DateStr : DateTime;
{$ENDIF}
Trash : WORD;
Time : LONGINT;
FileName : STRING;
Begin
If (Path<>'') AND (Path[length(Path)]<>'\') Then Path := Path + '\';
Repeat
With DateStr Do
Begin
GETDATE( Year, Month, Day, Trash );
GETTIME( Hour, Min, Sec, Trash );
End;
PackTime( DateStr, Time );
{$R-,Q-}
System.Str(Time,Filename);
FileName := Copy(Filename,1,8);
FileName := Filename+'.$$$';
{$R+,Q+}
Until Not FileExists(Path + FileName);
TempFile := Path + FileName;
END;
Function WordWrap(S:String; Var Remainder:String; Len:Byte):String;
Var W:String;
I:Integer;
begin
If S[1]=' ' then delete(S,1,1);
If Length(S)<=Len then
begin
WordWrap:=S;
Remainder:='';
Exit;
end;
For I:=Len downto 1 do
begin
If S[I]=' ' then
begin
WordWrap:=Copy(S,1,I);
Remainder:=Copy(S,I,Length(S)-I+1);
Exit;
end;
end;
end;
Function AN(S:String):String;
begin
While S[1]=' ' do delete(S,1,1);
If UPCASE(S[1]) IN ['A','E','I','O','U'] THEN INSERT('an ',S,1) ELSE
INSERT('a ',S,1);
AN:=S;
end;
Function LastDrive: Char; Assembler;
Asm
mov ah, 19h
int 21h
push ax { save default drive }
mov ah, 0Eh
mov dl, 19h
int 21h
mov cl, al
dec cx
@@CheckDrive:
mov ah, 0Eh { check if drive valid }
mov dl, cl
int 21h
mov ah, 19h
int 21h
cmp cl, al
je @@Valid
dec cl { check next lovest drive number }
jmp @@CheckDrive
@@Valid:
pop ax
mov dl, al
mov ah, 0Eh
int 21h { restore default drive }
mov al, cl
add al, 'A'
end;
Function LongToHex(L:Longint):String;
var S:string;
begin
ConvertBase(10,StrL(L),16,S);
LongToHex:=S;
end;
End.
[Back to MAIL SWAG index] [Back to Main SWAG index] [Original]