Initial commit
This commit is contained in:
commit
e7150ee045
38
GapMerger/GapMerger.cfg
Normal file
38
GapMerger/GapMerger.cfg
Normal file
@ -0,0 +1,38 @@
|
||||
-$A8
|
||||
-$B-
|
||||
-$C+
|
||||
-$D+
|
||||
-$E-
|
||||
-$F-
|
||||
-$G+
|
||||
-$H+
|
||||
-$I+
|
||||
-$J-
|
||||
-$K-
|
||||
-$L+
|
||||
-$M-
|
||||
-$N+
|
||||
-$O+
|
||||
-$P+
|
||||
-$Q-
|
||||
-$R-
|
||||
-$S-
|
||||
-$T-
|
||||
-$U-
|
||||
-$V+
|
||||
-$W-
|
||||
-$X+
|
||||
-$YD
|
||||
-$Z1
|
||||
-cg
|
||||
-AWinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE;
|
||||
-H+
|
||||
-W+
|
||||
-M
|
||||
-$M16384,1048576
|
||||
-K$00400000
|
||||
-LE"c:\program files\borland\delphi7\Projects\Bpl"
|
||||
-LN"c:\program files\borland\delphi7\Projects\Bpl"
|
||||
-w-UNSAFE_TYPE
|
||||
-w-UNSAFE_CODE
|
||||
-w-UNSAFE_CAST
|
||||
139
GapMerger/GapMerger.dof
Normal file
139
GapMerger/GapMerger.dof
Normal file
@ -0,0 +1,139 @@
|
||||
[FileVersion]
|
||||
Version=7.0
|
||||
[Compiler]
|
||||
A=8
|
||||
B=0
|
||||
C=1
|
||||
D=1
|
||||
E=0
|
||||
F=0
|
||||
G=1
|
||||
H=1
|
||||
I=1
|
||||
J=0
|
||||
K=0
|
||||
L=1
|
||||
M=0
|
||||
N=1
|
||||
O=1
|
||||
P=1
|
||||
Q=0
|
||||
R=0
|
||||
S=0
|
||||
T=0
|
||||
U=0
|
||||
V=1
|
||||
W=0
|
||||
X=1
|
||||
Y=1
|
||||
Z=1
|
||||
ShowHints=1
|
||||
ShowWarnings=1
|
||||
UnitAliases=WinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE;
|
||||
NamespacePrefix=
|
||||
SymbolDeprecated=1
|
||||
SymbolLibrary=1
|
||||
SymbolPlatform=1
|
||||
UnitLibrary=1
|
||||
UnitPlatform=1
|
||||
UnitDeprecated=1
|
||||
HResultCompat=1
|
||||
HidingMember=1
|
||||
HiddenVirtual=1
|
||||
Garbage=1
|
||||
BoundsError=1
|
||||
ZeroNilCompat=1
|
||||
StringConstTruncated=1
|
||||
ForLoopVarVarPar=1
|
||||
TypedConstVarPar=1
|
||||
AsgToTypedConst=1
|
||||
CaseLabelRange=1
|
||||
ForVariable=1
|
||||
ConstructingAbstract=1
|
||||
ComparisonFalse=1
|
||||
ComparisonTrue=1
|
||||
ComparingSignedUnsigned=1
|
||||
CombiningSignedUnsigned=1
|
||||
UnsupportedConstruct=1
|
||||
FileOpen=1
|
||||
FileOpenUnitSrc=1
|
||||
BadGlobalSymbol=1
|
||||
DuplicateConstructorDestructor=1
|
||||
InvalidDirective=1
|
||||
PackageNoLink=1
|
||||
PackageThreadVar=1
|
||||
ImplicitImport=1
|
||||
HPPEMITIgnored=1
|
||||
NoRetVal=1
|
||||
UseBeforeDef=1
|
||||
ForLoopVarUndef=1
|
||||
UnitNameMismatch=1
|
||||
NoCFGFileFound=1
|
||||
MessageDirective=1
|
||||
ImplicitVariants=1
|
||||
UnicodeToLocale=1
|
||||
LocaleToUnicode=1
|
||||
ImagebaseMultiple=1
|
||||
SuspiciousTypecast=1
|
||||
PrivatePropAccessor=1
|
||||
UnsafeType=0
|
||||
UnsafeCode=0
|
||||
UnsafeCast=0
|
||||
[Linker]
|
||||
MapFile=0
|
||||
OutputObjs=0
|
||||
ConsoleApp=1
|
||||
DebugInfo=0
|
||||
RemoteSymbols=0
|
||||
MinStackSize=16384
|
||||
MaxStackSize=1048576
|
||||
ImageBase=4194304
|
||||
ExeDescription=
|
||||
[Directories]
|
||||
OutputDir=
|
||||
UnitOutputDir=
|
||||
PackageDLLOutputDir=
|
||||
PackageDCPOutputDir=
|
||||
SearchPath=
|
||||
Packages=
|
||||
Conditionals=
|
||||
DebugSourceDirs=
|
||||
UsePackages=0
|
||||
[Parameters]
|
||||
RunParams=
|
||||
HostApplication=
|
||||
Launcher=
|
||||
UseLauncher=0
|
||||
DebugCWD=
|
||||
[Language]
|
||||
ActiveLang=
|
||||
ProjectLang=
|
||||
RootDir=
|
||||
[Version Info]
|
||||
IncludeVerInfo=0
|
||||
AutoIncBuild=0
|
||||
MajorVer=1
|
||||
MinorVer=0
|
||||
Release=0
|
||||
Build=0
|
||||
Debug=0
|
||||
PreRelease=0
|
||||
Special=0
|
||||
Private=0
|
||||
DLL=0
|
||||
Locale=1033
|
||||
CodePage=1252
|
||||
[Version Info Keys]
|
||||
CompanyName=
|
||||
FileDescription=
|
||||
FileVersion=1.0.0.0
|
||||
InternalName=
|
||||
LegalCopyright=
|
||||
LegalTrademarks=
|
||||
OriginalFilename=
|
||||
ProductName=
|
||||
ProductVersion=1.0.0.0
|
||||
Comments=
|
||||
[HistoryLists\hlUnitAliases]
|
||||
Count=1
|
||||
Item0=WinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE;
|
||||
114
GapMerger/GapMerger.dpr
Normal file
114
GapMerger/GapMerger.dpr
Normal file
@ -0,0 +1,114 @@
|
||||
program GapMerger;
|
||||
{$APPTYPE CONSOLE}
|
||||
|
||||
uses
|
||||
SysUtils,
|
||||
Windows,
|
||||
rbrConsTools in '..\rbrConsTools\rbrConsTools.pas';
|
||||
|
||||
const
|
||||
AppTitle: string = 'eMule Gap Merger';
|
||||
AppVersion: string = '1.0';
|
||||
|
||||
var
|
||||
OldConsTitle: PChar;
|
||||
infile1,infile2,outfile: file of char;
|
||||
Buf1, Buf2: array[1..64] of char;
|
||||
i,i1,i2,j: integer;
|
||||
WX,WY: integer;
|
||||
ct,bw,be: integer;
|
||||
ofs,ifs: longint;
|
||||
incon: longint;
|
||||
isempty: boolean;
|
||||
|
||||
begin
|
||||
try
|
||||
OldConsTitle := PChar(AllocMem(256));
|
||||
GetConsoleTitle(OldConsTitle,255);
|
||||
SetConsoleTitle(PChar(AppTitle+' '+AppVersion));
|
||||
TextColor(white);
|
||||
WriteLn('--==# '+AppTitle+' '+AppVersion+' #==--');
|
||||
TextColor(LightGray);
|
||||
WriteLn('(c)2003 by Markus Birth <mbirth@webwriters.de>');
|
||||
WriteLn;
|
||||
if (ParamCount<3) then begin
|
||||
TextColor(LightRed);
|
||||
WriteLn('Not enough actual parameters.');
|
||||
TextColor(LightGray);
|
||||
SetConsoleTitle(OldConsTitle);
|
||||
Halt(1);
|
||||
end;
|
||||
Write('Assigning files...');
|
||||
AssignFile(infile1,ParamStr(1));
|
||||
AssignFile(infile2,ParamStr(2));
|
||||
AssignFile(outfile,ParamStr(3));
|
||||
WriteLn('done.');
|
||||
Write('Opening files (existing output file will be overwritten)...');
|
||||
Reset(infile1);
|
||||
Reset(infile2);
|
||||
Rewrite(outfile);
|
||||
WriteLn('done.');
|
||||
if (FileSize(infile1)=FileSize(infile2)) then begin
|
||||
ifs := FileSize(infile1);
|
||||
WriteLn('Infiles are each ',ifs,' Bytes ~ ',ifs DIV 64,' Blocks');
|
||||
Write('Start merging...');
|
||||
WX := WhereX;
|
||||
WY := WhereY;
|
||||
ct := 0;
|
||||
bw := 0;
|
||||
be := 0;
|
||||
incon := 0;
|
||||
repeat
|
||||
BlockRead(infile1,Buf1,SizeOf(Buf1),i1);
|
||||
BlockRead(infile2,Buf2,SizeOf(Buf2),i2);
|
||||
if (i2>i1) then i := i2 else i := i1;
|
||||
isempty := true;
|
||||
for j:=1 to 64 do begin
|
||||
if (Ord(Buf1[j])=0) AND (Ord(Buf2[j])<>0) then Buf1[j] := Buf2[j];
|
||||
if (Ord(Buf2[j])<>0) AND (Buf1[j]<>Buf2[j]) then Inc(incon);
|
||||
if (Ord(Buf1[j])<>0) then isempty := false;
|
||||
end;
|
||||
BlockWrite(outfile,Buf1,i);
|
||||
Inc(bw);
|
||||
if isempty then Inc(be);
|
||||
Inc(ct);
|
||||
if (ct>=10000) then begin
|
||||
GotoXY(WX,WY);
|
||||
Write(bw,' Blocks written (',be,' empty)');
|
||||
ct := 0;
|
||||
end;
|
||||
until i=0;
|
||||
GotoXY(WX,WY);
|
||||
Write(bw,' Blocks written (',be,' empty)');
|
||||
WriteLn(' ... done.');
|
||||
ofs := FileSize(outfile);
|
||||
WriteLn('Outfile is ',ofs,' Bytes ~ ',ofs DIV 64,' Blocks');
|
||||
if (incon>0) then begin
|
||||
TextColor(LightRed);
|
||||
WriteLn('WARNING! Inconsistencies found! Output file may be corrupt!');
|
||||
WriteLn(incon,' inconsistent byte(s) found! (',incon*100/ofs:7:3,'%)');
|
||||
TextColor(LightGray);
|
||||
end;
|
||||
end else begin
|
||||
TextColor(lightred);
|
||||
WriteLn('!!ERROR!! Infiles have different sizes.');
|
||||
TextColor(lightgray);
|
||||
end;
|
||||
Write('Closing files...');
|
||||
CloseFile(infile1);
|
||||
CloseFile(infile2);
|
||||
CloseFile(outfile);
|
||||
WriteLn('done.');
|
||||
SetConsoleTitle(OldConsTitle);
|
||||
except
|
||||
on e: Exception do begin
|
||||
TextColor(LightRed+blink);
|
||||
WriteLn('error!');
|
||||
TextColor(LightRed);
|
||||
TextBackground(Black);
|
||||
WriteLn('Exception: '+e.Message);
|
||||
TextColor(LightGray);
|
||||
end;
|
||||
end;
|
||||
end.
|
||||
|
||||
15
GapMerger/README.md
Normal file
15
GapMerger/README.md
Normal file
@ -0,0 +1,15 @@
|
||||
GapMerger for eMule
|
||||
===================
|
||||
|
||||
Syntax: `GapMerger <infile1> <infile2> <outfile>`
|
||||
|
||||
|
||||
GapRemover parses both `<infilex>`s in 64Bytes-Blocks.
|
||||
It copies `<infile1>` to `<outfile>` except if a byte in `<infile1>` is 00h and the byte at the same position in `<infile2>` is NOT 00h.
|
||||
Then, the byte from `<infile2>` is written into `<outfile>`.
|
||||
|
||||
`<infile1>` and `<infile2>` have to be same size.
|
||||
|
||||
|
||||
I wrote this because I sometimes download the same file 2 times and both downloads have gaps at different parts of the file.
|
||||
This tool merges all data into one file.
|
||||
38
GapRemover/GapRemover.cfg
Normal file
38
GapRemover/GapRemover.cfg
Normal file
@ -0,0 +1,38 @@
|
||||
-$A8
|
||||
-$B-
|
||||
-$C+
|
||||
-$D+
|
||||
-$E-
|
||||
-$F-
|
||||
-$G+
|
||||
-$H+
|
||||
-$I+
|
||||
-$J-
|
||||
-$K-
|
||||
-$L+
|
||||
-$M-
|
||||
-$N+
|
||||
-$O+
|
||||
-$P+
|
||||
-$Q-
|
||||
-$R-
|
||||
-$S-
|
||||
-$T-
|
||||
-$U-
|
||||
-$V+
|
||||
-$W-
|
||||
-$X+
|
||||
-$YD
|
||||
-$Z1
|
||||
-cg
|
||||
-AWinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE;
|
||||
-H+
|
||||
-W+
|
||||
-M
|
||||
-$M16384,1048576
|
||||
-K$00400000
|
||||
-LE"c:\program files\borland\delphi7\Projects\Bpl"
|
||||
-LN"c:\program files\borland\delphi7\Projects\Bpl"
|
||||
-w-UNSAFE_TYPE
|
||||
-w-UNSAFE_CODE
|
||||
-w-UNSAFE_CAST
|
||||
139
GapRemover/GapRemover.dof
Normal file
139
GapRemover/GapRemover.dof
Normal file
@ -0,0 +1,139 @@
|
||||
[FileVersion]
|
||||
Version=7.0
|
||||
[Compiler]
|
||||
A=8
|
||||
B=0
|
||||
C=1
|
||||
D=1
|
||||
E=0
|
||||
F=0
|
||||
G=1
|
||||
H=1
|
||||
I=1
|
||||
J=0
|
||||
K=0
|
||||
L=1
|
||||
M=0
|
||||
N=1
|
||||
O=1
|
||||
P=1
|
||||
Q=0
|
||||
R=0
|
||||
S=0
|
||||
T=0
|
||||
U=0
|
||||
V=1
|
||||
W=0
|
||||
X=1
|
||||
Y=1
|
||||
Z=1
|
||||
ShowHints=1
|
||||
ShowWarnings=1
|
||||
UnitAliases=WinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE;
|
||||
NamespacePrefix=
|
||||
SymbolDeprecated=1
|
||||
SymbolLibrary=1
|
||||
SymbolPlatform=1
|
||||
UnitLibrary=1
|
||||
UnitPlatform=1
|
||||
UnitDeprecated=1
|
||||
HResultCompat=1
|
||||
HidingMember=1
|
||||
HiddenVirtual=1
|
||||
Garbage=1
|
||||
BoundsError=1
|
||||
ZeroNilCompat=1
|
||||
StringConstTruncated=1
|
||||
ForLoopVarVarPar=1
|
||||
TypedConstVarPar=1
|
||||
AsgToTypedConst=1
|
||||
CaseLabelRange=1
|
||||
ForVariable=1
|
||||
ConstructingAbstract=1
|
||||
ComparisonFalse=1
|
||||
ComparisonTrue=1
|
||||
ComparingSignedUnsigned=1
|
||||
CombiningSignedUnsigned=1
|
||||
UnsupportedConstruct=1
|
||||
FileOpen=1
|
||||
FileOpenUnitSrc=1
|
||||
BadGlobalSymbol=1
|
||||
DuplicateConstructorDestructor=1
|
||||
InvalidDirective=1
|
||||
PackageNoLink=1
|
||||
PackageThreadVar=1
|
||||
ImplicitImport=1
|
||||
HPPEMITIgnored=1
|
||||
NoRetVal=1
|
||||
UseBeforeDef=1
|
||||
ForLoopVarUndef=1
|
||||
UnitNameMismatch=1
|
||||
NoCFGFileFound=1
|
||||
MessageDirective=1
|
||||
ImplicitVariants=1
|
||||
UnicodeToLocale=1
|
||||
LocaleToUnicode=1
|
||||
ImagebaseMultiple=1
|
||||
SuspiciousTypecast=1
|
||||
PrivatePropAccessor=1
|
||||
UnsafeType=0
|
||||
UnsafeCode=0
|
||||
UnsafeCast=0
|
||||
[Linker]
|
||||
MapFile=0
|
||||
OutputObjs=0
|
||||
ConsoleApp=1
|
||||
DebugInfo=0
|
||||
RemoteSymbols=0
|
||||
MinStackSize=16384
|
||||
MaxStackSize=1048576
|
||||
ImageBase=4194304
|
||||
ExeDescription=
|
||||
[Directories]
|
||||
OutputDir=
|
||||
UnitOutputDir=
|
||||
PackageDLLOutputDir=
|
||||
PackageDCPOutputDir=
|
||||
SearchPath=
|
||||
Packages=
|
||||
Conditionals=
|
||||
DebugSourceDirs=
|
||||
UsePackages=0
|
||||
[Parameters]
|
||||
RunParams=
|
||||
HostApplication=
|
||||
Launcher=
|
||||
UseLauncher=0
|
||||
DebugCWD=
|
||||
[Language]
|
||||
ActiveLang=
|
||||
ProjectLang=
|
||||
RootDir=
|
||||
[Version Info]
|
||||
IncludeVerInfo=0
|
||||
AutoIncBuild=0
|
||||
MajorVer=1
|
||||
MinorVer=0
|
||||
Release=0
|
||||
Build=0
|
||||
Debug=0
|
||||
PreRelease=0
|
||||
Special=0
|
||||
Private=0
|
||||
DLL=0
|
||||
Locale=1033
|
||||
CodePage=1252
|
||||
[Version Info Keys]
|
||||
CompanyName=
|
||||
FileDescription=
|
||||
FileVersion=1.0.0.0
|
||||
InternalName=
|
||||
LegalCopyright=
|
||||
LegalTrademarks=
|
||||
OriginalFilename=
|
||||
ProductName=
|
||||
ProductVersion=1.0.0.0
|
||||
Comments=
|
||||
[HistoryLists\hlUnitAliases]
|
||||
Count=1
|
||||
Item0=WinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE;
|
||||
81
GapRemover/GapRemover.dpr
Normal file
81
GapRemover/GapRemover.dpr
Normal file
@ -0,0 +1,81 @@
|
||||
program GapRemover;
|
||||
{$APPTYPE CONSOLE}
|
||||
|
||||
uses
|
||||
SysUtils,
|
||||
Windows,
|
||||
rbrConsTools in '..\rbrConsTools\rbrConsTools.pas';
|
||||
|
||||
const
|
||||
AppTitle: string = 'eMule Gap Remover';
|
||||
AppVersion: string = '1.0';
|
||||
|
||||
var
|
||||
OldConsTitle: PChar;
|
||||
infile,outfile: file of char;
|
||||
Buf: array[1..64] of char;
|
||||
i,j: integer;
|
||||
isnull: boolean;
|
||||
WX,WY: integer;
|
||||
ct,bw,bs: integer;
|
||||
ofs,ifs: longint;
|
||||
|
||||
begin
|
||||
OldConsTitle := PChar(AllocMem(256));
|
||||
GetConsoleTitle(OldConsTitle,255);
|
||||
SetConsoleTitle(PChar(AppTitle+' '+AppVersion));
|
||||
TextColor(white);
|
||||
WriteLn('--==# '+AppTitle+' '+AppVersion+' #==--');
|
||||
TextColor(LightGray);
|
||||
WriteLn('(c)2003 by Markus Birth <mbirth@webwriters.de>');
|
||||
WriteLn;
|
||||
if (ParamCount<2) then begin
|
||||
TextColor(LightRed);
|
||||
WriteLn('Not enough actual parameters.');
|
||||
TextColor(LightGray);
|
||||
SetConsoleTitle(OldConsTitle);
|
||||
Halt(1);
|
||||
end;
|
||||
Write('Assigning files...');
|
||||
AssignFile(infile,ParamStr(1));
|
||||
AssignFile(outfile,ParamStr(2));
|
||||
WriteLn('done.');
|
||||
Write('Opening files (existing output file will be overwritten)...');
|
||||
Reset(infile);
|
||||
Rewrite(outfile);
|
||||
WriteLn('done.');
|
||||
ifs := FileSize(infile);
|
||||
WriteLn('Infile is ',ifs,' Bytes ~ ',ifs DIV 64,' Blocks');
|
||||
Write('Start copying...');
|
||||
WX := WhereX;
|
||||
WY := WhereY;
|
||||
ct := 0;
|
||||
bw := 0;
|
||||
bs := 0;
|
||||
repeat
|
||||
BlockRead(infile,Buf,SizeOf(Buf),i);
|
||||
isnull := true;
|
||||
for j:=1 to 64 do if Ord(Buf[j])<>0 then isnull:=false;
|
||||
if NOT isnull then begin
|
||||
BlockWrite(outfile,Buf,i);
|
||||
Inc(bw);
|
||||
end else Inc(bs);
|
||||
Inc(ct);
|
||||
if (ct>=10000) then begin
|
||||
GotoXY(WX,WY);
|
||||
Write('Blocks: ',bw+bs,' processed / ',bw,' written / ',bs,' skipped');
|
||||
ct := 0;
|
||||
end;
|
||||
until i=0;
|
||||
GotoXY(WX,WY);
|
||||
Write('Blocks: ',bw+bs,' processed / ',bw,' written / ',bs,' skipped');
|
||||
WriteLn(' ... done.');
|
||||
ofs := FileSize(outfile);
|
||||
WriteLn('Outfile is ',ofs,' Bytes ~ ',ofs DIV 64,' Blocks');
|
||||
WriteLn('Outfile is ',ofs*100/ifs:7:3,'% of Infile');
|
||||
Write('Closing files...');
|
||||
CloseFile(infile);
|
||||
CloseFile(outfile);
|
||||
WriteLn('done.');
|
||||
SetConsoleTitle(OldConsTitle);
|
||||
end.
|
||||
11
GapRemover/README.md
Normal file
11
GapRemover/README.md
Normal file
@ -0,0 +1,11 @@
|
||||
GapRemover for eMule
|
||||
====================
|
||||
|
||||
Syntax: `GapRemover <infile> <outfile>`
|
||||
|
||||
|
||||
GapRemover parses `<infile>` in 64Bytes-Blocks.
|
||||
Those blocks are copied into `<outfile>` if they contain anything other than 00h-Bytes.
|
||||
|
||||
I wrote this because my Media Player keeps freezing when there are errors in the stream.
|
||||
This procedure keeps the freezes short.
|
||||
31
README.md
Normal file
31
README.md
Normal file
@ -0,0 +1,31 @@
|
||||
eMule-Tools
|
||||
===========
|
||||
|
||||
GapRemover
|
||||
----------
|
||||
|
||||
Syntax: `GapRemover <infile> <outfile>`
|
||||
|
||||
|
||||
GapRemover parses `<infile>` in 64Bytes-Blocks.
|
||||
Those blocks are copied into `<outfile>` if they contain anything other than 00h-Bytes.
|
||||
|
||||
I wrote this because my Media Player keeps freezing when there are errors in the stream.
|
||||
This procedure keeps the freezes short.
|
||||
|
||||
|
||||
GapMerger
|
||||
---------
|
||||
|
||||
Syntax: `GapMerger <infile1> <infile2> <outfile>`
|
||||
|
||||
|
||||
GapRemover parses both `<infilex>`s in 64Bytes-Blocks.
|
||||
It copies `<infile1>` to `<outfile>` except if a byte in `<infile1>` is 00h and the byte at the same position in `<infile2>` is NOT 00h.
|
||||
Then, the byte from `<infile2>` is written into `<outfile>`.
|
||||
|
||||
`<infile1>` and `<infile2>` have to be same size.
|
||||
|
||||
|
||||
I wrote this because I sometimes download the same file 2 times and both downloads have gaps at different parts of the file.
|
||||
This tool merges all data into one file.
|
||||
234
rbrConsTools/rbrConsTools.pas
Normal file
234
rbrConsTools/rbrConsTools.pas
Normal file
@ -0,0 +1,234 @@
|
||||
unit rbrConsTools;
|
||||
|
||||
interface
|
||||
|
||||
const
|
||||
Black = 0;
|
||||
Blue = 1;
|
||||
Green = 2;
|
||||
Cyan = 3;
|
||||
Red = 4;
|
||||
Magenta = 5;
|
||||
Brown = 6;
|
||||
LightGray = 7;
|
||||
DarkGray = 8;
|
||||
LightBlue = 9;
|
||||
LightGreen = 10;
|
||||
LightCyan = 11;
|
||||
LightRed = 12;
|
||||
LightMagenta = 13;
|
||||
Yellow = 14;
|
||||
White = 15;
|
||||
blink = 128;
|
||||
|
||||
procedure TextColor(x: byte);
|
||||
procedure TextBackground(x: byte);
|
||||
procedure GotoXY(x,y: integer);
|
||||
function WhereX: integer;
|
||||
function WhereY: integer;
|
||||
procedure ClrScr;
|
||||
procedure ClrEol;
|
||||
function ReadKeyAsWord: Word;
|
||||
function keypressed: boolean;
|
||||
function ProgBar(width: integer; pos: double; memslot: byte = 1; forcewrite: boolean = false): boolean;
|
||||
function ProgBarLn(width: integer; pos: double; memslot: byte = 1; forcewrite: boolean = false): boolean;
|
||||
function ProgBarAt(x,y: integer; width: integer; pos: double; memslot: byte = 1; forcewrite: boolean = false): boolean;
|
||||
function working(step: longint = 1; memslot: byte = 1): boolean;
|
||||
|
||||
implementation
|
||||
|
||||
uses Windows;
|
||||
|
||||
const
|
||||
wiString = '/-\|';
|
||||
|
||||
var
|
||||
hConsoleInput: THandle;
|
||||
hConsoleOutput: THandle;
|
||||
wiPos: array[1..10] of byte;
|
||||
wkPos: array[1..10] of longint;
|
||||
ProgBarSave: array[1..10] of integer;
|
||||
i: integer;
|
||||
|
||||
procedure TextColor(x: byte);
|
||||
var BI : CONSOLE_SCREEN_BUFFER_INFO;
|
||||
att : word;
|
||||
begin
|
||||
GetConsoleScreenBufferInfo(hConsoleOutput, BI);
|
||||
att := BI.wAttributes;
|
||||
att := att AND $F0;
|
||||
{ ANDing with 11110000 to let the current bg-color remain }
|
||||
SetConsoleTextAttribute(hConsoleOutput, x+att);
|
||||
end;
|
||||
|
||||
procedure TextBackground(x: byte);
|
||||
var BI : CONSOLE_SCREEN_BUFFER_INFO;
|
||||
att : word;
|
||||
begin
|
||||
GetConsoleScreenBufferInfo(hConsoleOutput, BI);
|
||||
att := BI.wAttributes;
|
||||
att := att AND $0F;
|
||||
{ ANDing with 00001111 to let the current fg-color remain }
|
||||
SetConsoleTextAttribute(hConsoleOutput, x*$10+att);
|
||||
end;
|
||||
|
||||
procedure GotoXY(x,y: integer);
|
||||
var Pos: COORD;
|
||||
begin
|
||||
Pos.X := x-1;
|
||||
Pos.Y := y-1;
|
||||
{ 1 is subtracted because the top-left pos in Pascal was (1,1) instead of (0,0) }
|
||||
SetConsoleCursorPosition(hConsoleOutput,Pos);
|
||||
end;
|
||||
|
||||
function WhereX: integer;
|
||||
var SBI: CONSOLE_SCREEN_BUFFER_INFO;
|
||||
begin
|
||||
GetConsoleScreenBufferInfo(hConsoleOutput,SBI);
|
||||
WhereX := SBI.dwCursorPosition.X + 1;
|
||||
{ 1 is added because in Pascal the top-left position was (1,1) and not (0,0) }
|
||||
end;
|
||||
|
||||
function WhereY: integer;
|
||||
var SBI: CONSOLE_SCREEN_BUFFER_INFO;
|
||||
begin
|
||||
GetConsoleScreenBufferInfo(hConsoleOutput,SBI);
|
||||
WhereY := SBI.dwCursorPosition.Y + 1;
|
||||
{ 1 is added because in Pascal the top-left position was (1,1) and not (0,0) }
|
||||
end;
|
||||
|
||||
procedure ClrScr;
|
||||
var coordScreen: COORD;
|
||||
SBI: CONSOLE_SCREEN_BUFFER_INFO;
|
||||
charsWritten: longword;
|
||||
ConSize: longword;
|
||||
begin
|
||||
coordScreen.X := 0; coordScreen.Y := 0;
|
||||
GetConsoleScreenBufferInfo(hConsoleOutput, SBI);
|
||||
ConSize := SBI.dwSize.X * SBI.dwSize.Y;
|
||||
FillConsoleOutputCharacter(hConsoleOutput, ' ', ConSize, coordScreen, charsWritten);
|
||||
FillConsoleOutputAttribute(hConsoleOutput, SBI.wAttributes, ConSize, coordScreen, charsWritten);
|
||||
SetConsoleCursorPosition(hConsoleOutput, coordScreen);
|
||||
end;
|
||||
|
||||
procedure ClrEol;
|
||||
var tC :tCoord;
|
||||
Len,Nw: longword;
|
||||
Cbi : TConsoleScreenBufferInfo;
|
||||
begin
|
||||
GetConsoleScreenBufferInfo(hConsoleOutput, cbi);
|
||||
len := cbi.dwsize.x-cbi.dwcursorposition.x;
|
||||
tc.x := cbi.dwcursorposition.x;
|
||||
tc.y := cbi.dwcursorposition.y;
|
||||
FillConsoleOutputAttribute(hConsoleOutput,cbi.wAttributes,len,tc,nw);
|
||||
FillConsoleOutputCharacter(hConsoleOutput,#32,len,tc,nw);
|
||||
end;
|
||||
|
||||
function ReadKeyAsWord: Word;
|
||||
var Read: Cardinal;
|
||||
Rec: _INPUT_RECORD;
|
||||
begin
|
||||
repeat
|
||||
Rec.EventType := KEY_EVENT;
|
||||
ReadConsoleInput(hConsoleInput, Rec, 1, Read);
|
||||
until (Read = 1) AND (Rec.Event.KeyEvent.bKeyDown);
|
||||
Result := Rec.Event.KeyEvent.wVirtualKeyCode;
|
||||
end;
|
||||
|
||||
function ReadKey: Char;
|
||||
var Ch: Char;
|
||||
NumRead: DWORD;
|
||||
SaveMode: DWORD;
|
||||
begin
|
||||
GetConsoleMode(hConsoleInput, SaveMode);
|
||||
SetConsoleMode(hConsoleInput, 0);
|
||||
NumRead := 0;
|
||||
while NumRead < 1 do ReadConsole(hConsoleInput, @Ch, 1, NumRead, nil);
|
||||
SetConsoleMode(hConsoleInput, SaveMode);
|
||||
Result := Ch;
|
||||
end;
|
||||
|
||||
function keypressed: boolean;
|
||||
var NumberOfEvents: longword;
|
||||
InputRec: TInputRecord;
|
||||
NumRead: DWORD;
|
||||
begin
|
||||
Result := false;
|
||||
GetNumberOfConsoleInputEvents(hConsoleInput, NumberOfEvents);
|
||||
if NumberOfEvents > 0 then begin
|
||||
if PeekConsoleInput(hConsoleInput, InputRec, 1, NumRead) then begin
|
||||
if (InputRec.EventType = KEY_EVENT) AND (InputRec.Event.KeyEvent.bKeyDown) AND (InputRec.Event.KeyEvent.AsciiChar > #0) then begin
|
||||
Result := true;
|
||||
end else begin
|
||||
FlushConsoleInputBuffer(hConsoleInput);
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
function ProgBarChanged(width: integer; pos: double; memslot: byte = 1): boolean;
|
||||
var nexstep: integer;
|
||||
begin
|
||||
nexstep := Trunc(3 * width * pos); // 3 steps in 1 char
|
||||
// WriteLn('this: ',ProgBarSave[memslot],' --- next: ',nexstep);
|
||||
if (ProgBarSave[memslot] <> nexstep) then Result := true else Result := false;
|
||||
end;
|
||||
|
||||
function ProgBar(width: integer; pos: double; memslot: byte = 1; forcewrite: boolean = false): boolean;
|
||||
var cp, curstep: integer;
|
||||
begin
|
||||
if (forcewrite) OR (ProgBarChanged(width, pos, memslot)) then begin
|
||||
curstep := Trunc(3 * width * pos);
|
||||
cp := 1;
|
||||
while cp<=width do begin
|
||||
if (curstep>=cp*3) then Write(Chr($db))
|
||||
else if (curstep>=(cp-1)*3+2) then Write(Chr($b2))
|
||||
else if (curstep>=(cp-1)*3+1) then Write(Chr($b1))
|
||||
else Write(Chr($b0));
|
||||
Inc(cp);
|
||||
end;
|
||||
ProgBarSave[memslot] := Trunc(3 * width * pos);
|
||||
Result := true;
|
||||
end else begin
|
||||
Result := false;
|
||||
GotoXY(WhereX+width, WhereY);
|
||||
end;
|
||||
end;
|
||||
|
||||
function ProgBarLn(width: integer; pos: double; memslot: byte = 1; forcewrite: boolean = false): boolean;
|
||||
begin
|
||||
Result := ProgBar(width, pos, memslot, forcewrite);
|
||||
WriteLn;
|
||||
end;
|
||||
|
||||
function ProgBarAt(x,y: integer; width: integer; pos: double; memslot: byte = 1; forcewrite: boolean = false): boolean;
|
||||
begin
|
||||
if (ProgBarChanged(width, pos, memslot)) OR (forcewrite) then begin
|
||||
GotoXY(x,y);
|
||||
Result := ProgBar(width, pos, memslot, true);
|
||||
end else Result := false;
|
||||
end;
|
||||
|
||||
function working(step: longint = 1; memslot: byte = 1): boolean;
|
||||
begin
|
||||
if (wkPos[memslot]>=step) then begin
|
||||
Write(wiString[wiPos[memslot]]);
|
||||
Inc(wiPos[memslot]);
|
||||
if (wiPos[memslot] > Length(wiString)) then wiPos[memslot] := 1;
|
||||
wkPos[memslot] := 1;
|
||||
Result := true;
|
||||
end else begin
|
||||
Inc(wkPos[memslot]);
|
||||
Result := false;
|
||||
end;
|
||||
end;
|
||||
|
||||
begin
|
||||
for i:=1 to 10 do begin
|
||||
wiPos[i] := 1;
|
||||
wkPos[i] := 1;
|
||||
end;
|
||||
hConsoleInput := GetStdHandle(STD_INPUT_HANDLE);
|
||||
hConsoleOutput := GetStdHandle(STD_OUTPUT_HANDLE);
|
||||
|
||||
end.
|
||||
Reference in New Issue
Block a user