unit ads_wbserver_util;
{Copyright(c)2016 Advanced Delphi Systems
Richard Maley
Advanced Delphi Systems
12613 Maidens Bower Drive
Potomac, MD 20854 USA
phone 301-840-1554
dickmaley@advdelphisys.com
The code herein can be used or modified by anyone. Please retain references
to Richard Maley at Advanced Delphi Systems. If you make improvements to the
code please send your improvements to dickmaley@advdelphisys.com so that the
entire Delphi community can benefit. All comments are welcome.
}
(*UnitIndex Master Index Implementation Section Download UnitsDescription: ads_wbserver_util.pas This unit contains the following routines.
ConvertIntegerToBinaryString ConvertWordToBinaryString FieldNameFromList FilesInDirDetail KeyPressOnlyNumbers KeyPressOnlyNumbersAbsolute NumbersOnly NumbersOnlyAbsolute StringPad ValidateStrFieldType
*)
interface
Uses Classes, SysUtils, FileCtrl;
{!~ Converts an integer value to its binary equivalent
as a ShortString }
Function ConvertIntegerToBinaryString(Int, Length : Integer) : ShortString;
{!~ Converts a word value to its binary equivalent
as a ShortString }
Function ConvertWordToBinaryString(InputWord : Word; Length : Integer) : ShortString;
{!~ Returns the name aof a filed from a list where values are arranged
as FieldName=FiledValue}
Function FieldNameFromList(lst : TStringList; index : Integer): String;
{!~ Populates a TStrings FileList with the files meeting selected
file attribute criteria in a directory. The mask argument is a
standard DOS file argument like '*.*. The InclDotFiles argument
allows the user to exclude the system files "." and ".." by
setting the value to False. If the Intersection argument is set
to true then the result will reflect only those files that satisfy
all attribute criteria. If Intersection is set to false then the
result will be a union of files that meet any of the criteria.}
Function FilesInDirDetail(
FileList : TStrings;
Directory : String;
Mask : String;
Intersection: Boolean;
IsReadOnly : Boolean;
IsHidden : Boolean;
IsSystem : Boolean;
IsVolumeID : Boolean;
IsDirectory : Boolean;
IsArchive : Boolean;
IsNormal : Boolean;
InclDotFiles: Boolean): Boolean;
{!~ Throws away all keys except 0-9,-,+,.}
Procedure KeyPressOnlyNumbers(Var Key: Char);
{!~ Throws away all keys except 0-9}
Procedure KeyPressOnlyNumbersAbsolute(Var Key: Char);
{!~ Throws away all characters except 0-9,-,+,.}
Function NumbersOnly(InputString: String): String;
{!~ Throws away all characters except 0-9}
Function NumbersOnlyAbsolute(InputString: String): String;
{!~ Pads or truncates a String and Justifies Left if StrJustify=True}
Function StringPad(
InputStr,
FillChar: String;
StrLen: Integer;
StrJustify: Boolean): String;
{!~ Formats and validates values based on FieldType. If Value is completely
invalid for the type then an empty string is retruned.}
Function ValidateStrFieldType(FieldType,Value : String): String;
implementation
{!~ Converts an integer value to its binary equivalent
as a ShortString }
//Unit Description UnitIndex Master Index
Function ConvertIntegerToBinaryString(Int, Length : Integer) : ShortString;
Begin
Result := ConvertWordToBinaryString(Word(Int),Length);
End;
{!~ Converts a word value to its binary equivalent
as a ShortString }
//Unit Description UnitIndex Master Index
Function ConvertWordToBinaryString(InputWord : Word; Length : Integer) : ShortString;
var
Counter, Number : Cardinal;
D : Array[0..1] of Char;
Begin
D[0] := '0';
D[1] := '1';
Number := 1;
Result[0] := #16;
For Counter := 15 Downto 0 Do
Begin
Result[Number] :=
D[Ord(InputWord and (1 shl Counter) <> 0)];
Inc(Number);
End;
If Length > 16 Then Length := 16;
If Length < 1 Then Length := 1;
Result := Copy(Result,16-Length,Length);
End;
{!~ Populates a TStrings FileList with the files meeting selected
file attribute criteria in a directory. The mask argument is a
standard DOS file argument like '*.*. The InclDotFiles argument
allows the user to exclude the system files "." and ".." by
setting the value to False. If the Intersection argument is set
to true then the result will reflect only those files that satisfy
all attribute criteria. If Intersection is set to false then the
result will be a union of files that meet any of the criteria.}
//Unit Description UnitIndex Master Index
Function FilesInDirDetail(
FileList : TStrings;
Directory : String;
Mask : String;
Intersection: Boolean;
IsReadOnly : Boolean;
IsHidden : Boolean;
IsSystem : Boolean;
IsVolumeID : Boolean;
IsDirectory : Boolean;
IsArchive : Boolean;
IsNormal : Boolean;
InclDotFiles: Boolean): Boolean;
var
j : Integer;
MaskPtr : PChar;
Ptr : PChar;
FileInfo : TSearchRec;
CurDir : String;
FileType : TFileType;
FileType_I : Integer;
FileType_B : ShortString;
TSList : TStringList;
BinaryAttr : ShortString;
ShouldAdd : Boolean;
begin
{ Result := False;}{zzz}
TSList := TStringList.Create();
Try
Try
FileType := [];
If IsReadOnly Then FileType := (FileType + [ftReadOnly]);
If IsHidden Then FileType := (FileType + [ftHidden]);
If IsSystem Then FileType := (FileType + [ftSystem]);
If IsVolumeID Then FileType := (FileType + [ftVolumeID]);
If IsDirectory Then FileType := (FileType + [ftDirectory]);
If IsArchive Then FileType := (FileType + [ftArchive]);
If IsNormal Then FileType := (FileType + [ftNormal]);
FileType_I := 0;
If IsReadOnly Then FileType_I := (FileType_I + 1);
If IsHidden Then FileType_I := (FileType_I + 2);
If IsSystem Then FileType_I := (FileType_I + 4);
If IsVolumeID Then FileType_I := (FileType_I + 8);
If IsDirectory Then FileType_I := (FileType_I + 16);
If IsArchive Then FileType_I := (FileType_I + 32);
If IsNormal Then FileType_I := (FileType_I + 128);
FileType_B := ConvertIntegerToBinaryString(FileType_I,8);
TSList.Clear;
GetDir(0,CurDir);
ChDir(Directory); { go to the directory we want }
FileList.Clear; { clear the list }
MaskPtr := PChar(Mask);
while MaskPtr <> nil do
begin
Ptr := StrScan (MaskPtr, ';');
If Ptr <> nil Then Ptr^ := #0;
If FindFirst(MaskPtr, 191, FileInfo) = 0 Then
Begin
Repeat { exclude normal files if ftNormal not set }
Begin
If ftNormal in FileType Then
Begin
TSList.Add(FileInfo.Name);
End
Else
Begin
BinaryAttr := ConvertIntegerToBinaryString(FileInfo.Attr,8);
If Intersection Then
Begin
ShouldAdd := True;
For j := 1 To 8 Do
Begin
If (FileType_B[j]='1') And (BinaryAttr[j]<>'1') Then
Begin
ShouldAdd := False;
Break;
End;
End;
If ShouldAdd Then
TSList.Add(FileInfo.Name);
End
Else
Begin
For j := 1 To 8 Do
Begin
If (FileType_B[j]='1') And (BinaryAttr[j]='1') Then
Begin
TSList.Add(FileInfo.Name);
Break;
End;
End;
End;
End;
End;
Until FindNext(FileInfo) <> 0;
{zzz Changed 4/17/99 rlm}
//FindClose(FileInfo.FindHandle);
FindClose(FileInfo);
End;
If Ptr <> nil then
begin
Ptr^ := ';';
Inc (Ptr);
end;
MaskPtr := Ptr;
end;
ChDir(CurDir);
TSList.Sorted := False;
If Not InclDotFiles Then
Begin
If TSList.IndexOf('.') > -1 Then
TSLIst.Delete(TSList.IndexOf('.'));
If TSList.IndexOf('..') > -1 Then
TSLIst.Delete(TSList.IndexOf('..'));
End;
TSList.Sorted := True;
TSList.Sorted := False;
FileList.Assign(TSList);
Result := True;
Except
Result := False;
End;
Finally
TSList.Free;
End;
end;
{!~ Pads or truncates a String and Justifies Left if StrJustify=True}
//Unit Description UnitIndex Master Index
Function StringPad(
InputStr,
FillChar: String;
StrLen: Integer;
StrJustify: Boolean): String;
Var
TempFill: String;
Counter : Integer;
Begin
If Not (Length(InputStr) = StrLen) Then
Begin
If Length(InputStr) > StrLen Then
Begin
InputStr := Copy(InputStr,1,StrLen);
End
Else
Begin
TempFill := '';
For Counter := 1 To StrLen-Length(InputStr) Do
Begin
TempFill := TempFill + FillChar;
End;
If StrJustify Then
Begin
{Left Justified}
InputStr := InputStr + TempFill;
End
Else
Begin
{Right Justified}
InputStr := TempFill + InputStr ;
End;
End;
End;
Result := InputStr;
End;
{!~ Throws away all keys except 0-9,-,+,.}
//Unit Description UnitIndex Master Index
Procedure KeyPressOnlyNumbers(Var Key: Char);
Begin
Case Key Of
'0': Exit;
'1': Exit;
'2': Exit;
'3': Exit;
'4': Exit;
'5': Exit;
'6': Exit;
'7': Exit;
'8': Exit;
'9': Exit;
'-': Exit;
'+': Exit;
'.': Exit;
#8 : Exit; {Backspace}
End;
Key := #0; {Throw the key away}
End;
{!~ Throws away all keys except 0-9}
//Unit Description UnitIndex Master Index
Procedure KeyPressOnlyNumbersAbsolute(Var Key: Char);
Begin
Case Key Of
'0': Exit;
'1': Exit;
'2': Exit;
'3': Exit;
'4': Exit;
'5': Exit;
'6': Exit;
'7': Exit;
'8': Exit;
'9': Exit;
#8 : Exit; {Backspace}
End;
Key := #0; {Throw the key away}
End;
{!~ Throws away all characters except 0-9,-,+,.}
//Unit Description UnitIndex Master Index
Function NumbersOnly(InputString: String): String;
Var
NewString: String;
L : Integer;
i : Integer;
C : Char;
Begin
Result := InputString;
NewString := '';
L := Length(InputString);
For i:= 1 To L Do
Begin
C := InputString[i];
KeyPressOnlyNumbers(C);
If Not (C = #0) Then
Begin
NewString := NewString + C;
End;
End;
Result := NewString;
End;
{!~ Throws away all characters except 0-9}
//Unit Description UnitIndex Master Index
Function NumbersOnlyAbsolute(InputString: String): String;
Var
NewString: String;
L : Integer;
i : Integer;
C : Char;
Begin
Result := InputString;
NewString := '';
L := Length(InputString);
For i:= 1 To L Do
Begin
C := InputString[i];
If Not(
(C='+') Or
(C='-') Or
(C='.') Or
(C=',')) Then
Begin
KeyPressOnlyNumbers(C);
If Not (C = #0) Then
Begin
If NewString = '0' Then NewString := '';
NewString := NewString + C;
End;
End;
End;
Result := NewString;
End;
{!~ Formats and validates values based on FieldType. If Value is completely
invalid for the type then an empty string is retruned.}
//Unit Description UnitIndex Master Index
Function ValidateStrFieldType(FieldType,Value : String): String;
Var
sgTemp : String;
Begin
FieldType := UpperCase(FieldType);
Result := '';
//Cannot Validate
If FieldType = 'ADT' Then Begin Result := ''; Exit; End;
If FieldType = 'ARRAY' Then Begin Result := ''; Exit; End;
If FieldType = 'BCD' Then Begin Result := ''; Exit; End;
If FieldType = 'BLOB' Then Begin Result := ''; Exit; End;
If FieldType = 'CURSOR' Then Begin Result := ''; Exit; End;
If FieldType = 'DATASET' Then Begin Result := ''; Exit; End;
If FieldType = 'DBASEOLE' Then Begin Result := ''; Exit; End;
If FieldType = 'GRAPHIC' Then Begin Result := ''; Exit; End;
If FieldType = 'PARADOXOLE' Then Begin Result := ''; Exit; End;
If FieldType = 'REFERENCE' Then Begin Result := ''; Exit; End;
If FieldType = 'TYPEDBINARY' Then Begin Result := ''; Exit; End;
If FieldType = 'UNKNOWN' Then Begin Result := ''; Exit; End;
//Just return what was sent in
If FieldType = 'BYTES' Then Begin Result := Value; Exit; End;
If FieldType = 'FIXEDCHAR' Then Begin Result := Value; Exit; End;
If FieldType = 'FMTMEMO' Then Begin Result := Value; Exit; End;
If FieldType = 'MEMO' Then Begin Result := Value; Exit; End;
If FieldType = 'STRING' Then Begin Result := Value; Exit; End;
If FieldType = 'VARBYTES' Then Begin Result := Value; Exit; End;
If FieldType = 'WIDESTRING' Then Begin Result := Value; Exit; End;
If FieldType = 'WORD' Then Begin Result := Value; Exit; End;
//Float Types
sgTemp := NumbersOnly(Value);
If FieldType = 'CURRENCY' Then Begin Result := sgTemp; Exit; End;
If FieldType = 'FLOAT' Then Begin Result := sgTemp; Exit; End;
//Integer Types
sgTemp := NumbersOnlyAbsolute(Value);
If FieldType = 'AUTOINC' Then Begin Result := sgTemp; Exit; End;
If FieldType = 'INTEGER' Then Begin Result := sgTemp; Exit; End;
If FieldType = 'LARGEINT' Then Begin Result := sgTemp; Exit; End;
If FieldType = 'SMALLINT' Then Begin Result := sgTemp; Exit; End;
//Date Types
Try
sgTemp := FormatDateTime('mm/dd/yyyy',StrToDateTime(Value));
If FieldType = 'DATE' Then Begin Result := sgTemp; Exit; End;
sgTemp := FormatDateTime('mm/dd/yyyy hh:nn:ss',StrToDateTime(Value));
If FieldType = 'DATETIME' Then Begin Result := sgTemp; Exit; End;
sgTemp := FormatDateTime('hh:nn:ss',StrToDateTime(Value));
If FieldType = 'TIME' Then Begin Result := sgTemp; Exit; End;
Except
Result := '';
Exit;
End;
If FieldType = 'BOOLEAN' Then
Begin
sgTemp := UpperCase(Copy(Trim(Value),1,1));
If (sgTemp = 'T') Or
(sgTemp = 'F') Or
(sgTemp = 'Y') Or
(sgTemp = 'N') Or
(sgTemp = '0') Or
(sgTemp = '1') Then
Begin
Result := sgTemp;
End
Else
Begin
Result := '';
End;
End
End;
{!~ Returns the name aof a filed from a list where values are arranged
as FieldName=FiledValue}
//Unit Description UnitIndex Master Index
Function FieldNameFromList(lst : TStringList; index : Integer): String;
Var
sgTemp : String;
inPos : Integer;
Begin
Try
Result := '';
sgTemp := lst[index];
sgTemp := Trim(sgTemp);
inPos := Pos('=',sgTemp);
If inPos > 0 Then
Begin
sgTemp := Copy(sgTemp,1,inPos-1);
End
Else
Begin
sgTemp := '';
End;
Result := sgTemp;
Except
Result := '';
End;
End;
end.
//