//Example of Excel Export from Scholz DB
//#sign:max: MAXBOX8: 6/5/2014 3:28:39 PM
//http://www.scholz2000.com/wp-content/uploads/updates/Scholz_Rundbrief_2014_8.pdf
Program UML_SQL_ExcelExport;
Const SCHOLZALIAS = 'SAS'; //'Knabe'; // 'SAS';
Const DB_TABLENAME = 'Skonto';
//DB_FIELD = 'Bezeichnung';
DB_FIELD = '*';
//SQLQuery = 'Select '+DB_FIELD+' from '+DB_TABLENAME;
{Fakturiert = 90;
Erledigt = 50;
Unerledigt = 10; in AufAtb - Status ; Auftrag - StatusMin}
const ABAUFTRAG1 = '294000'; //SQL Filter
ASTATUS1 = '10'; //Status siehe oben }
Const QUERYSWITCH = true; //true is query, false is Exec
{ SQLQuery =
'Select AuftragsNr, KundenNr, StatusMin '+
'from Auftrag where '+
//'Auftrag.AuftragsNr = AufAtb.AuftragsNr AND AufAtb.KundenNr = Kunde.KundenNr '+
' StatusMin = '+ASTATUS1+' AND AuftragsNr > '+ABAUFTRAG1+' ORDER BY AuftragsNr';}
//SQLQuery = 'Select count(*) from Aufpos where AuftragsNr < 2050000';
SQLQuery = 'Select count(*) from Auftrag where AuftragsNr > 0';
// SQLQuery = 'UPDATE Auftrag SET StatusMin = 10 WHERE AuftragsNr = 294542';
//SQLQuery = 'UPDATE AufAtb SET Status = 10 WHERE AuftragsNr = 294543';
//Delete Auftrag and Refs!
//SQLQuery = 'DELETE FROM Auftrag Where AuftragsNr < 100019';
//SQLQuery = 'DELETE FROM AufAtb Where AuftragsNr < 100019';
//SQLQueryExec = 'DELETE FROM Aufpos Where AuftragsNr <= 190029 AND '+
// 'AuftragsNr >= 190027';
SQLQueryExec = 'DELETE FROM Auftrag Where AuftragsNr <= 294400 AND '+
'AuftragsNr >= 0';
//SQLQuery = 'Select * from Skonto where Bezeichnung like "%sofort%"';
//***************************************************************
LEFTBASE = 20;
TOPBASE = 25;
VARRSIZE = 200;
type
//TThreadSortArray = array[0..MaxInt div SizeOf(Integer) - 1] of Integer;
TmSortArray = array[0..VARRSIZE] of Integer;
var
mymemo: TMemo;
mpaint, mpaint2, mpaint3: TPaintBox;
//BubbleSortBox, SelectionSortBox, QuickSortBox: TPaintBox;
bigstring: string;
inFrm: TForm;
mbtn3: TBitBtn;
Lstbox: TListbox;
stat: TStatusbar;
selectedFile: string;
BubbleSortArray: TSortArray;
SelectionSortArray: TSortArray;
QuickSortArray: TSortArray;
ArraysRandom: Boolean;
FA, FB, FI, FJ: Integer;
ThreadsRunning: byte;
procedure PaintLine(Canvas: TCanvas; I, Len: Integer); forward;
procedure RandomizeArrays;
var
I: Integer;
begin
//I:= 0;
//if b then dialogs.showmessage('this is')
assert2(high(BubbleSortArray) <= 80, 'array to big');
//Check(high(BubbleSortArray) <= 170, 'array to big');
if not ArraysRandom then begin
Randomize;
writeln(inttostr(arrsize))
for I:= 1 to ARRSIZE - 1 do
//SelectionSortarray[i]:= random(165);
//writeln(inttostr(i));
BubbleSortArray[I]:= Random(160);
SelectionSortArray:= BubbleSortArray;
QuickSortArray:= BubbleSortArray;
writeln('just random thread done')
end;
end;
procedure PaintRandomArray;
var I: integer;
begin
mPaint2.Canvas.Pen.Color:= clblue;
for I:= Low(QuickSortArray) to High(QuickSortArray) do
PaintLine(mpaint3.Canvas, I, QuickSortArray[I]);
for I:= Low(SelectionSortArray) to High(SelectionSortArray) do
PaintLine(mpaint2.Canvas, I, SelectionSortArray[I]);
mPaint.Canvas.Pen.Color:= clgreen;
for I:= Low(BubbleSortArray) to High(BubbleSortArray) do
PaintLine(mpaint.Canvas, I, BubbleSortArray[I])
end;
procedure PaintLine(Canvas: TCanvas; I, Len: Integer);
begin
canvas.moveTo(0, I * 2 + 1)
canvas.LineTo(Len, I * 2 + 1)
//Canvas.PolyLine([Point(0, I * 2 + 1), Point(Len, I * 2 + 1)]);
end;
procedure DoVisualSwap2;
begin
with mpaint2 do begin
//invalidate;
Canvas.Pen.Color:= clBtnFace;
//Canvas.Pen.Color:= clBlue;
PaintLine(Canvas, FI, FA);
PaintLine(Canvas, FJ, FB);
Canvas.Pen.Color:= clRed;
PaintLine(Canvas, FI, FB);
PaintLine(Canvas, FJ, FA);
end;
end;
procedure DoVisualSwap;
begin
with mpaint do begin
//invalidate;
Canvas.Pen.Color:= clBtnFace;
//Canvas.Pen.Color:= clBlue;
PaintLine(Canvas, FI, FA);
PaintLine(Canvas, FJ, FB);
Canvas.Pen.Color:= clRed;
PaintLine(Canvas, FI, FB);
PaintLine(Canvas, FJ, FA);
end;
end;
procedure VisualSwap2(A, B, I, J: Integer);
begin
//symbol rename
FA:= A; FB:= B;
FI:= I; FJ:= J;
//DoVisualSwap;
DoVisualSwap2;
end;
procedure VisualSwap(A, B, I, J: Integer);
begin
//symbol rename
FA:= A;
FB:= B;
FI:= I;
FJ:= J;
//if bolTHslowmotion then
// sysutils.sleep(5);
DoVisualSwap;
DoVisualSwap2;
end;
procedure TmSelectionSort(var A: TmSortArray);
// syncedit
var
indx, J, T: Integer;
begin
for indx := Low(A) to High(A) - 1 do
for J := High(A) downto indx + 1 do
if A[indx] > A[J] then begin
VisualSwap(A[indx], A[J], indx, J);
//write('debug')
T:= A[indx];
A[indx] := A[J];
A[J] := T;
//if Terminated then Exit;
end;
end;
{ TBubbleSort }
procedure TmBubbleSort(var A: TmSortArray);
var
I, J, T: Integer;
begin
for I := High(A) downto Low(A) do
for J := Low(A) to High(A) - 1 do
if A[J] > A[J + 1] then begin
VisualSwap2(A[J], A[J + 1], J, J + 1);
T := A[J];
A[J] := A[J + 1];
A[J + 1] := T;
end;
end;
procedure QuickSort(var A: TmSortArray; iLo, iHi: Integer);
var
Lo, Hi, Mid, T: Integer;
begin
Lo := iLo;
Hi := iHi;
// inline variable
Mid:= A[(Lo + Hi) div 2];
repeat
while A[Lo] < Mid
do Inc(Lo);
while A[Hi] > Mid
do Dec(Hi);
if Lo <= Hi then begin
VisualSwap(A[Lo], A[Hi], Lo, Hi);
T:= A[Lo];
A[Lo]:= A[Hi];
A[Hi]:= T;
Inc(Lo);
Dec(Hi);
end;
until Lo > Hi;
if Hi > iLo then QuickSort(A, iLo, Hi);
if Lo < iHi then QuickSort(A, Lo, iHi);
//if Terminated then Exit;
end;
procedure TmQuickSort(var A: TmSortArray);
begin
QuickSort(A, Low(A), High(A));
end;
Function getRandomText: string;
var i, getback: integer;
begin
result:= Chr(32)
for i:= 1 to 1400 do begin
getback:= random(58)+65
if (getback < 91) OR (getback > 96) then
result:= result + Chr(getback) +Chr(32)
end;
end;
//Event Handler - Closure
Procedure GetMediaData(self: TObject);
begin
if PromptForFileName(selectedFile,
'Text files (*.txt)|*.txt','',
'Select your mX3 test file',
ExePath+'examples\', False) // Means not a Save dialog !
then begin
// Display this full file/path value
ShowMessage('Selected file = '+selectedFile);
Stat.simpletext:= selectedFile;
mymemo.lines.LoadFromFile(selectedFile);
// Split this full file/path value into its constituent parts
//writeln('PromptForFileName_28: Res of processpath '+tmp)
end;
end;
procedure ThreadDone(Sender: TObject);
begin
Dec(ThreadsRunning);
if ThreadsRunning = 0 then begin
//StartBtn.Enabled:= True;
//randArray.ArraysRandom:= False;
Writeln('all threads gone');
end;
end;
//Event Handler - Closure
procedure BtnStartClick(self: TObject);
begin
//mymemo.lines.savetofile(ExePath+'\examples\mymemomemoire.txt');
mymemo.lines.text:= getRandomText;
mPaint.invalidate;
mPaint2.invalidate;
mPaint3.invalidate;
ThreadsRunning:= 3;
RandomizeArrays;
//PaintRandomArray;
{ with TSortThread.Create(mPaint, bubblesortarray) do begin
slowmotion:= 200;
end;}
//marr:= TRandomArray.create;
//marr.RandomizeArrays(inFrm, false)
//marr.PaintArray(mPaint)
//bubblesortbox
ProcessMessagesOFF;
with TBubbleSort.Create(mpaint, BubbleSortArray) do begin
bolTHslowmotion:= true;
slowmotion:= 0;
//sort
OnTerminate:= @ThreadDone;
end;
//selectionsortbox
with TSelectionSort.Create(mpaint2, SelectionSortArray) do begin
bolTHslowmotion:= true;
slowmotion:= 0;
//sort
OnTerminate:= @ThreadDone;
end;
//application.ProcessMessages;
with TQuickSort.Create(mpaint3, QuickSortArray) do begin
bolTHslowmotion:= true;
slowmotion:= 0;
//sort
OnTerminate:= @ThreadDone;
end;
ProcessMessagesON;
//marr.Free;
//msort:= TSortThread.Create(mPaint,sortarray)
//TmSelectionSort(selectionSortArray)
//TmBubbleSort(bubbleSortArray)
//mymemo.lines.SaveToFile(selectedFile);
Stat.simpletext:= ' start has been sorted' ;
end;
procedure GetRandom(self: TObject);
begin
//mymemo.lines.savetofile(ExePath+'\examples\mymemomemoire.txt');
mymemo.lines.text:= getRandomText;
mPaint.invalidate;
mPaint2.invalidate;
mPaint3.invalidate;
RandomizeArrays;
PaintRandomArray;
end;
procedure BtnSortClick(self: TObject);
begin
//mymemo.lines.savetofile(ExePath+'\examples\mymemomemoire.txt');
//RandomizeArrays(inFrm);
//PaintRandomArray;
mPaint.invalidate;
mPaint2.invalidate;
mPaint3.invalidate;
//TmSelectionSort(selectionSortArray)
//TmBubbleSort(bubbleSortArray)
//mymemo.lines.SaveToFile(selectedFile);
//Stat.simpletext:= selectedFile+ ' has been saved' ;
end;
procedure JCLStringsTester;
var tester, tester2: string;
testeransi: ansistring;
stl: TStringlist;
begin
{template s}
tester:= 'this is HEX in the BOX';
tester2:= 'this is MAX in the TEX';
//ReplaceFirst(const SourceStr, FindStr, ReplaceStr: string): string;
writeln(ReplaceFirst(tester, 'HEX', 'MAX'));
//ReplaceLast(const SourceStr, FindStr, ReplaceStr: string): string;
//InsertLastBlock(var SourceStr: string; BlockStr: string): Boolean;
//RemoveMasterBlocks(const SourceStr: string): string;
//RemoveFields(const SourceStr: string): string;
{http s}
testeransi:= 'http://www.softwareschule.ch/maxbox.htm';
//URLEncode(const Value: AnsiString): AnsiString; // Converts string To A URLEncoded string
writeln(URLEncode(testeransi)); // Converts string To A URLEncoded string
//URLDecode(const Value: AnsiString): AnsiString; // Converts string From A URLEncoded string
writeln(URLDecode(URLEncode(testeransi))); // Converts string To A URLEncoded string
{set s}
//procedure SplitSet(AText: string; AList: TStringList);
stl:= TStringlist.Create;
SplitSet(tester,stl);
writeln(JoinSet(stl));
writeln(FirstOfSet(tester));
writeln((LastOfSet(tester)));
writeln(inttostr(CountOfSet(tester)));
//SetRotateRight(const AText: string): string;
//SetRotateLeft(const AText: string): string;
//SetPick(const AText: string; AIndex: Integer): string;
Writeln('sort: '+SetSort(tester));
writeln('union: '+SetUnion(tester, tester2));
//SetIntersect(const Set1, Set2: string): string;
writeln('intersect: '+SetIntersect(tester, tester2));
//SetExclude(const Set1, Set2: string): string;
writeln('exclude: '+SetExclude(tester, tester2));
{replace any <,> etc by < >}
//XMLSafe(const AText: string): string;
{simple hash, Result can be used in Encrypt}
//Hash(const AText: string): Integer;
writeln('hash: '+inttostr(Hash(tester)));
SaveString(exepath+'savestring.txt',tester);
writeln(dateTimeToStr(Easter(2013)));
{ Base64 encode and decode a string }
//B64Encode(const S: AnsiString): AnsiString;
//B64Decode(const S: AnsiString): AnsiString;
{Basic encryption from a Borland Example}
//Encrypt(const InString: AnsiString; StartKey, MultKey, AddKey: Integer): AnsiString;
//Decrypt(const InString: AnsiString; StartKey, MultKey, AddKey: Integer): AnsiString;
{Using Encrypt and Decrypt in combination with B64Encode and B64Decode}
//EncryptB64(const InString: AnsiString; StartKey, MultKey, AddKey: Integer): AnsiString;
//DecryptB64(const InString: AnsiString; StartKey, MultKey, AddKey: Integer): AnsiString;
(*procedure CSVToTags(Src, Dst: TStringList);
// converts a csv list to a tagged string list
procedure TagsToCSV(Src, Dst: TStringList);
// converts a tagged string list to a csv list
// only fieldnames from the first record are scanned ib the other records
procedure ListSelect(Src, Dst: TStringList; const AKey, AValue: string);
{selects akey=avalue from Src and returns recordset in Dst}
procedure ListFilter(Src: TStringList; const AKey, AValue: string);
{filters Src for akey=avalue}
procedure ListOrderBy(Src: TStringList; const AKey: string; Numeric: Boolean);
{orders a tagged Src list by akey}
PosStr(const FindString, SourceString: string;
StartPos: Integer = 1): Integer;
{ PosStr searches the first occurrence of a substring FindString in a string
given by SourceString with case sensitivity (upper and lower case characters
are differed). This returns the index value of the first character
of a specified substring from which it occurs in a given string starting with
StartPos character index. If a specified substring is not found Q_PosStr
returns zero. The author of algorithm is Peter Morris (UK) (Faststrings unit
from www.torry.ru). }
PosStrLast(const FindString, SourceString: string): Integer;
{finds the last occurance}
LastPosChar(const FindChar: Char; SourceString: string): Integer;
PosText(const FindString, SourceString: string;
StartPos: Integer = 1): Integer;
{ PosText searches the first occurrence of a substring FindString in a string
given by SourceString without case sensitivity (upper and lower case
characters are not differed). This returns the index value of the
first character of a specified substring from which it occurs in a given
string starting with StartPos character index. If a specified substring is
not found Q_PosStr returns zero. The author of algorithm is Peter Morris
(UK) (Faststrings unit from www.torry.ru). }
PosTextLast(const FindString, SourceString: string): Integer;
{finds the last occurance}
NameValuesToXML(const AText: string): string;
{$IFDEF MSWINDOWS}
procedure LoadResourceFile(AFile: string; MemStream: TMemoryStream);
{$ENDIF MSWINDOWS}
procedure DirFiles(const ADir, AMask: string; AFileList: TStringList);
procedure RecurseDirFiles(const ADir: string; var AFileList: TStringList);
procedure RecurseDirProgs(const ADir: string; var AFileList: TStringList);
procedure SaveString(const AFile, AText: string);
LoadString(const AFile: string): string;
HexToColor(const AText: string): TColor;
UppercaseHTMLTags(const AText: string): string;
LowercaseHTMLTags(const AText: string): string;
procedure GetHTMLAnchors(const AFile: string; AList: TStringList);
RelativePath(const ASrc, ADst: string): string;
GetToken(var Start: Integer; const SourceText: string): string;
PosNonSpace(Start: Integer; const SourceText: string): Integer;
PosEscaped(Start: Integer; const SourceText, FindText: string; EscapeChar: Char): Integer;
DeleteEscaped(const SourceText: string; EscapeChar: Char): string;
BeginOfAttribute(Start: Integer; const SourceText: string): Integer;
// parses the beginning of an attribute: space + alpha character
ParseAttribute(var Start: Integer; const SourceText: string; var AName, AValue: string): Boolean;
// parses a name="value" attribute from Start; returns 0 when not found or else the position behind the attribute
procedure ParseAttributes(const SourceText: string; Attributes: TStrings);
// parses all name=value attributes to the attributes TStringList
HasStrValue(const AText, AName: string; var AValue: string): Boolean;
// checks if a name="value" pair exists and returns any value
GetStrValue(const AText, AName, ADefault: string): string;
// retrieves string value from a line like:
// name="jan verhoeven" email="jan1 dott verhoeven att wxs dott nl"
// returns ADefault when not found
GetHTMLColorValue(const AText, AName: string; ADefault: TColor): TColor;
// same for a color
GetIntValue(const AText, AName: string; ADefault: Integer): Integer;
// same for an Integer
GetFloatValue(const AText, AName: string; ADefault: Extended): Extended;
// same for a float
GetBoolValue(const AText, AName: string): Boolean;
// same for Boolean but without default
GetValue(const AText, AName: string): string;
// retrieves string value from a line like:
// name="jan verhoeven" email="jan1 dott verhoeven att wxs dott nl"
procedure SetValue(var AText: string; const AName, AValue: string);
// sets a string value in a line
procedure DeleteValue(var AText: string; const AName: string);
// deletes a AName="value" pair from AText
procedure GetNames(AText: string; AList: TStringList);
// get a list of names from a string with name="value" pairs
GetHTMLColor(AColor: TColor): string;
// converts a color value to the HTML hex value
BackPosStr(Start: Integer; const FindString, SourceString: string): Integer;
// finds a string backward case sensitive
BackPosText(Start: Integer; const FindString, SourceString: string): Integer;
// finds a string backward case insensitive
PosRangeStr(Start: Integer; const HeadString, TailString, SourceString: string;
var RangeBegin: Integer; var RangeEnd: Integer): Boolean;
// finds a text range, e.g. | .... | case sensitive
PosRangeText(Start: Integer; const HeadString, TailString, SourceString: string;
var RangeBegin: Integer; var RangeEnd: Integer): Boolean;
// finds a text range, e.g. .... | case insensitive
BackPosRangeStr(Start: Integer; const HeadString, TailString, SourceString: string;
var RangeBegin: Integer; var RangeEnd: Integer): Boolean;
// finds a text range backward, e.g. .... | case sensitive
BackPosRangeText(Start: Integer; const HeadString, TailString, SourceString: string;
var RangeBegin: Integer; var RangeEnd: Integer): Boolean;
// finds a text range backward, e.g. .... | case insensitive
PosTag(Start: Integer; SourceString: string; var RangeBegin: Integer;
var RangeEnd: Integer): Boolean;
// finds a HTML or XML tag: <....>
InnerTag(Start: Integer; const HeadString, TailString, SourceString: string;
var RangeBegin: Integer; var RangeEnd: Integer): Boolean;
// finds the innertext between opening and closing tags
Easter(NYear: Integer): TDateTime;
// returns the easter date of a year.
GetWeekNumber(Today: TDateTime): string;
//gets a datecode. Returns year and weeknumber in format: YYWW *)
Writeln('parse: '+inttoStr(ParseNumber(tester)))
//ParseNumber(const S: string): Integer;
// parse number returns the last position, starting from 1
//Writeln(inttostr(ParseDate(tester)));
// parse a SQL style data string from positions 1,
// starts and ends with #
end;
procedure SetForm;
var
mbtn, mbtn2: TBitBtn;
mi, mi1, mi2, mi3: TMenuItem;
mt: TMainMenu;
mlbl, mlbl1: TLabel;
begin
inFrm:= TForm.Create(self);
mLbl:= TLabel.create(inFrm);
mLbl1:= TLabel.create(inFrm);
mPaint:= TPaintBox.Create(inFrm);
mPaint2:= TPaintBox.Create(inFrm);
mPaint3:= TPaintBox.Create(inFrm);
stat:= TStatusbar.Create(inFrm);
Lstbox:= TListbox.create(inFrm);
mymemo:= TMemo.create(inFrm);
with inFrm do begin
caption:= '********SortMonster3************';
height:= 610;
width:= 1180;
//color:= clred;
Position:= poScreenCenter;
//onClose:= @CloseClick;
Show;
end;
with mPaint do begin
Parent:= inFrm;
SetBounds(LEFTBASE+20,TOPBASE+70,200,400)
color:= clsilver;
Show;
//onpaint:= @closeclick;
end;
with mPaint2 do begin
Parent:= inFrm;
SetBounds(LEFTBASE+220,TOPBASE+70,200,400)
color:= clsilver;
Show;
//onpaint:= @closeclick;
end;
with mPaint3 do begin
Parent:= inFrm;
SetBounds(LEFTBASE+420,TOPBASE+70,200,400)
color:= clsilver;
Show;
//onpaint:= @closeclick;
end;
with mymemo do begin
Parent:= inFrm;
SetBounds(LEFTBASE+720, TOPBASE+40, 400, 400)
font.size:= 14;
color:= clYellow;
wordwrap:= true;
scrollbars:= ssvertical;
end;
mBtn:= TBitBtn.Create(inFrm)
with mBtn do begin
Parent:= inFrm;
setbounds(LEFTBASE+ 490, TOPBASE+ 460,150, 40);
caption:= 'Random';
font.size:= 12;
glyph.LoadFromResourceName(getHINSTANCE,'CL_MPPAUSE');
//event handler
onclick:= @GetRandom;
end;
mBtn2:= TBitBtn.Create(inFrm)
with mBtn2 do begin
Parent:= inFrm;
setbounds(LEFTBASE+ 330, TOPBASE+460,150, 40);
caption:= 'Sort';
font.size:= 12;
glyph.LoadFromResourceName(getHINSTANCE,'CL_MPEJECT');
//event handler
onclick:= @BtnSortClick;
end;
mBtn3:= TBitBtn.Create(inFrm)
with mBtn3 do begin
Parent:= inFrm;
setbounds(LEFTBASE+ 650, TOPBASE+460,150, 40);
caption:= 'Start Sort';
font.size:= 12;
//glyph.LoadFromResourceName(getHINSTANCE,'PREVIEWGLYPH');
glyph.LoadFromResourceName(getHINSTANCE,'CL_MPSTEP');
//event handler
onclick:= @BtnStartClick;
end;
with mlbl do begin
parent:= inFrm;
setbounds(LEFTBASE+5,TOPBASE-15,180,20);
font.size:= 28;
font.color:= clred;
//font.style:= [fsunderline]
caption:= 'SortThreadApp HEX in BOX';
end;
with mlbl1 do begin
parent:= inFrm;
setbounds(LEFTBASE+715,TOPBASE-1,180,20);
font.size:= 20;
font.color:= clred;
caption:= 'Text File:';
end;
mt:= TMainMenu.Create(infrm)
with mt do begin
//parent:= frmMon;
end;
mi:= TMenuItem.Create(mt)
mi1:= TMenuItem.Create(mt)
mi2:= TMenuItem.Create(mt)
mi3:= TMenuItem.Create(mi)
with mi do begin
//parent:= frmMon;
Caption:='Play Media';
Name:='ITEM';
mt.Items.Add(mi);
//OnClick:= @GetMediaData;
end;
with mi1 do begin
//parent:= frmMon;
Caption:='Show Video';
Name:='ITEM2';
mt.Items.Add(mi1) ;
//OnClick:= @GetVideoData
end;
with mi2 do begin
//parent:= frmMon;
Caption:='Open CD Player';
Name:='ITEM3';
mt.Items.Add(mi2);
//OnClick:= @OPenCD;
end;
with mi3 do begin
Caption:='Open maXbook';
Name:='ITEM4';
//mi.Items[0].add(mi3);
end;
with Stat do begin
parent:= inFrm;
stat.SimplePanel:= true;
end;
end;
{********** File 9: E:\SAS\Planung\Data.pas
fDBHandle:hDBIDb;
487: FullFilename:string;
bActive:Boolean;
if not active then active:=true;
498: FullFilename:=DataDir + TableName; // mit komplettem Pfad
end;
501: // ShowMessage('Komprimiere: '+FullFilename);
Check(DbiGetCursorProps(aTable.Handle, Props));
FillChar(TableDesc, SizeOf(CrTblDesc), #0);
506: StrPCopy(TableDesc.szTblname, FullFilename);
StrPCopy(TableDesc.szTblType, Props.szTableType); // szPARADOX
aTable.Active:=bActive;
515: // ShowMessage('Komprimiert: '+FullFilename);
except
}
//const SQLQuery = 'select count(*) from Auftrag.DB';
//const SQLQuery = 'Select Fertig, BeginnDatum, AuftragsNr, LeistungsNr from ZeitBtmp where AuftragsNr > 2000000';
{Fakturiert = 90;
Erledigt = 50;
Unerledigt = 10; }
const ABAUFTRAG = '10000'; //SQL Filter
ASTATUS = '10'; //Status siehe oben }
// ASTATUS2 =
{ SQLQuery =
'Select AuftragsNr, KundenNr, Suchbegriff, Status, Termin, Menge, VKTotal, ProgNr '+
'from Auftrag, AufAtb, Kunde where '+
'Auftrag.AuftragsNr = AufAtb.AuftragsNr AND AufAtb.KundenNr = Kunde.KundenNr '+
'AND Status = '+ASTATUS+' AND AuftragsNr > '+ABAUFTRAG+' ORDER BY KundenNr, Termin, Menge'; }
//****************************** SAS TOOLS *******************************//
// SQLQuery =
// 'Select '+DB_FIELD+' from '+DB_TABLENAME;
SQLQuery2 =
'Select Bezeichnung1 from Artikel.DB';
SQLQuery3 =
'Select Produkt from ATB.DB';
// Const SCHOLZALIAS = 'SAS';
//'Graefen'; //'SAS'; //'Knabe2014'; //'SAS'; //Graefen
//const SQLQuery = 'select * from Auftrag.DB where KundenNr = 105001'+
// 'AND MaschNr = 470 AND Nutzen = 4';
//const SQLQueryExec = 'DELETE FROM Auftrag AuftragsNr=''100008''';
//const SQLQueryExec = 'DELETE FROM Auftrag where AuftragsNr=100008';
//SQLQueryExec = 'ALTER TABLE Vorgaben ADD Nutzen smallint';
// SQLQueryExec = 'ALTER TABLE Vorgaben ADD CadDateiIstProgNr boolean';
// SQLQueryExec = 'ALTER TABLE PrParams ADD AufPrintBeschreibung2 boolean';
//SQLQueryExec = 'ALTER TABLE PrParams ADD AufPrintBeschreibung2Name CHAR(50)';
//SQLQueryExec = 'ALTER TABLE PrParams ADD AufPrintBeschreibung2View CHAR(20)';
// SQLQueryExec = 'ALTER TABLE PrParams ADD AngTextbreite Integer';
// SQLQueryExec = 'ALTER TABLE PrParams ADD AbTextbreite Integer';
// SQLQueryExec = 'ALTER TABLE PrParams ADD AufTextbreite Integer';
//SQLQueryExec = 'ALTER TABLE PrParams ADD ReTextbreite Integer';
// SQLQueryExec = 'ALTER TABLE PrParams ADD LSTextbreite Integer';
// SQLQueryExec = 'ALTER TABLE Kunde ADD ABErforderlich Boolean';
// SQLQueryExec = 'ALTER TABLE Kunde ADD REPrintAufschlag Boolean';
// SQLQueryExec = 'ALTER TABLE Auftrag ADD Beschreibung2 BLOB';
//SQLQueryExec = 'ALTER TABLE Vorgaben ADD HilfstypNrPerfa char(5)';
//SQLQueryExec = 'ALTER TABLE Vorgaben ADD HilfstypNrResy char(5)';
// add Query gto TIM.exe
//const SQLQueryExec = 'ALTER TABLE Skonto ADD Fixtag smallint';
//const SQLQueryExec = 'ALTER TABLE PRParams ADD AbPrintAnsprechpartner boolean';
//const SQLQueryExec = 'ALTER TABLE PrParams ADD AufPrintLieferempfaenger boolean';
//SQLQueryExec = 'ALTER TABLE Kunde DROP Briefanrede';
//SQLQueryExec = 'ALTER TABLE Kunde ADD Briefanrede char(50)';
//SQLQueryExec = 'ALTER TABLE Liefer ADD Briefanrede char(50)';
//Integer = LONG, Boolean = LOGICAL smallint=SHORT
const SQLQueryExec1 = 'ALTER TABLE Skonto ADD Fixtag smallint';
SQLQueryExec2 = 'ALTER TABLE PRParams ADD AbPrintAnsprechpartner boolean';
SQLQueryExec3 = 'ALTER TABLE PrParams ADD AufPrintLieferempfaenger boolean';
//SQLQueryExec4 = 'ALTER TABLE Kunde DROP Briefanrede';
SQLQueryExec4 = 'ALTER TABLE Kunde ADD Briefanrede char(50)';
SQLQueryExec5 = 'ALTER TABLE Liefer ADD Briefanrede char(50)';
SQLQueryExec6 = 'ALTER TABLE PrParams ADD BstPrintAdresskopf boolean';
SQLQueryExec7 = 'ALTER TABLE PrParams ADD BstPrintAdresskopfFax boolean';
SQLQueryExec8 = 'ALTER TABLE PrParams ADD BstPrintAbsenderzeile boolean';
SQLQueryExec9 = 'ALTER TABLE PrParams ADD BstPrintAbsenderzeileFax boolean';
SQLQueryExec10 = 'ALTER TABLE PrParams ADD BstPrintLogo boolean';
SQLQueryExec11 = 'ALTER TABLE PrParams ADD BstPrintLogoFax boolean';
SQLQueryExec12 = 'ALTER TABLE PrParams ADD BstPrintAdresseFolgeseite boolean';
SQLQueryExec13 = 'ALTER TABLE PrParams ADD BstPrintAdresskopf2 boolean';
SQLQueryExec14 = 'ALTER TABLE PrParams ADD BstPrintAbsenderzeile2 boolean';
SQLQueryExec15 = 'ALTER TABLE PrParams ADD BstPrintLogo2 boolean';
SQLQueryExec16 = 'ALTER TABLE PrParams ADD BstPrintNrLinks boolean';
SQLQueryExec17 = 'ALTER TABLE PrParams ADD BstPrintAdresskopfMail boolean';
SQLQueryExec18 = 'ALTER TABLE PrParams ADD BstPrintAbsenderzeileMail boolean';
SQLQueryExec19 = 'ALTER TABLE PrParams ADD BstPrintLogoMail boolean';
SQLQueryExec20 = 'ALTER TABLE PrParams ADD BstPrintFaxNr boolean';
SQLQueryExec21 = 'ALTER TABLE PrParams ADD AngPrintAdresskopf boolean';
SQLQueryExec22 = 'ALTER TABLE PrParams ADD AngPrintAdresskopfFax boolean';
SQLQueryExec23 = 'ALTER TABLE PrParams ADD AngPrintAbsenderzeile boolean';
SQLQueryExec24 = 'ALTER TABLE PrParams ADD AngPrintAbsenderzeileFax boolean';
SQLQueryExec25 = 'ALTER TABLE PrParams ADD AngPrintLogo boolean';
SQLQueryExec26 = 'ALTER TABLE PrParams ADD AngPrintLogoFax boolean';
SQLQueryExec27 = 'ALTER TABLE PrParams ADD AngPrintFolgeseite boolean';
SQLQueryExec28 = 'ALTER TABLE PrParams ADD AngPrintAdresseFolgeseite boolean';
SQLQueryExec29 = 'ALTER TABLE PrParams ADD AngPrintAdresskopf2 boolean';
SQLQueryExec30 = 'ALTER TABLE PrParams ADD AngPrintAbsenderzeile2 boolean';
SQLQueryExec31 = 'ALTER TABLE PrParams ADD AngPrintLogo2 boolean';
SQLQueryExec32 = 'ALTER TABLE PrParams ADD AngPrintNrLinks boolean';
SQLQueryExec33 = 'ALTER TABLE PrParams ADD AngPrintAdresskopfMail boolean';
SQLQueryExec34 = 'ALTER TABLE PrParams ADD AngPrintAbsenderzeileMail boolean';
SQLQueryExec35 = 'ALTER TABLE PrParams ADD AngPrintLogoMail boolean';
SQLQueryExec36 = 'ALTER TABLE PrParams ADD AngPrintFaxNr boolean';
SQLQueryExec37 = 'ALTER TABLE PrParams ADD AbPrintAdresskopf boolean';
SQLQueryExec38 = 'ALTER TABLE PrParams ADD AbPrintAdresskopfFax boolean';
SQLQueryExec39 = 'ALTER TABLE PrParams ADD AbPrintAbsenderZeile boolean';
//SQLQueryExec40 = 'ALTER TABLE PrParams ADD AbPrintAbsenderZeileFax boolean';
//SQLQueryExec40 = 'ALTER TABLE PrParams ADD AbPrintLogo boolean';
//SQLQueryExec40 = 'ALTER TABLE PrParams ADD AbPrintLogoFax boolean';
//SQLQueryExec40 = 'ALTER TABLE PrParams ADD AbPrintAdresseFolgeseiten boolean';
//SQLQueryExec40 = 'ALTER TABLE PrParams ADD AbPrintAdresskopf2 boolean';
//SQLQueryExec40 = 'ALTER TABLE PrParams ADD AbPrintAbsenderzeile2 boolean';
//SQLQueryExec41 = 'ALTER TABLE PrParams ADD AbPrintLogo2 boolean';
{SQLQueryExec42 = 'ALTER TABLE PrParams ADD AbPrintNrLinks boolean';
SQLQueryExec43 = 'ALTER TABLE PrParams ADD AbPrintAdresskopfMail boolean';
SQLQueryExec44 = 'ALTER TABLE PrParams ADD AbPrintAbsenderzeileMail boolean';
SQLQueryExec45 = 'ALTER TABLE PrParams ADD AbPrintLogoMail boolean';
SQLQueryExec46 = 'ALTER TABLE PrParams ADD AbPrintFaxNr boolean';}
//SQLQueryExec40 = 'ALTER TABLE PrParams ADD AufPrintleerzeileArtikel boolean';
//SQLQueryExec40 = 'ALTER TABLE PrParams ADD AufPrintBarcodeAuftragsNr boolean';
//SQLQueryExec40 = 'ALTER TABLE PrParams ADD RePrintAdresskopf boolean';
//SQLQueryExec40 = 'ALTER TABLE PrParams ADD RePrintAbsenderzeile boolean';
//SQLQueryExec40 = 'ALTER TABLE PrParams ADD RePrintLogo boolean';
//SQLQueryExec40 = 'ALTER TABLE PrParams ADD RePrintAdresseFolgeseiten boolean';
//SQLQueryExec40 = 'ALTER TABLE PrParams ADD RePrintAdresskopf2 boolean';
//SQLQueryExec40 = 'ALTER TABLE PrParams ADD RePrintAbsenderzeile2 boolean';
//SQLQueryExec40 = 'ALTER TABLE PrParams ADD RePrintLogo2 boolean';
//SQLQueryExec42 = 'ALTER TABLE PrParams ADD RePrintNrLinks boolean';
//SQLQueryExec43 = 'ALTER TABLE PrParams ADD RePrintAdresskopfMail boolean';
SQLQueryExec40 = 'ALTER TABLE PrParams ADD RePrintAbsenderzeileMails3 boolean';
//SQLQueryExec45 = 'ALTER TABLE PrParams ADD RePrintLogoMail boolean';
//SQLQueryExec46 = 'ALTER TABLE PrParams ADD RePrintFaxNr boolean';
procedure DoExecQuery2(aDB: string);
var dQuery: TQuery;
begin
dQuery:= TQuery.create(self);
with dQuery do begin
DatabaseName:= aDB;
try
try
writeln('');
writeln('exec the query for DB starts: ');
SQL.Clear;
//SQL.Text:= SQLQueryExec;
writeln('exec sql ready to run: ');
ExecSQL;
//Writeln(inttostr(RecordCount)+' Records found: ')
except
raiselastexception;
showmessagebig('E: exec query 2 raiselastexception');
writeln('E: exec query 2 raiselastexception');
end
finally
//raiselastexception;
Close;
Free;
showmessagebig('Exec query 2 end success!');
//CloseDataBase(aDB)
end;
end
end;
// procedure DoQuery(aDB: TDataBase; afield: string);
procedure DoQuery(aDB: string; afield: string);
var i,z: integer;
dQuery: TQuery;
begin
dQuery:= TQuery.create(self);
with dQuery do begin
DatabaseName:= aDB;
try
//GetQuery(SQLQuery, dQuery)
SQL.Clear;
//SQL.Text:= 'select * from customer';
//SQL.Text:= SQLQuery;
Open;
Writeln(inttostr(RecordCount)+' Records found: ')
for i:= 0 to RecordCount - 1 do begin
for z:= 0 to Fieldcount - 1 do
// Write((Fields[z].asString)+' ');
//Writeln(intToStr(i)+' '+fieldbyname(afield).asString);
Writeln(intToStr(i)+' '+fields[z].asString);
Writeln('');
Next;
end;
//ExecSQL;
//ExportDataSetToExcel(dquery, NIL);
finally
Close;
Free;
//CloseDataBase(aDB)
end;
end
end;
procedure SQLIndexTbl(dbName, tblName, idxName, fldName : String);
var
sqlIdx : TQuery;
fldStr, buf, idxStr : String;
begin
idxStr := '';
fldStr := fldName;
{Parse the field string. If we find a semicolon, we know we've reached a delimiter.
After we get the field name, if there's a space, tack on the standard SQL naming syntax
and precede the field name with table name (e.g. "MyTable"."My Field Name")}
while Pos(';', fldStr) > 0 do begin
buf := Copy(fldStr, 0, Pos(';', fldStr) - 1);
if (Pos(' ', buf) > 0) then
buf := '"' + tblName + '"."' + buf + '"';
fldStr := Copy(fldStr, Pos(';', fldStr) + 1, Length(fldStr) - Pos(';', fldStr) + 1);
idxStr := idxStr + buf + ','
end;
{Have to repeat this step at the end because there will always be a remainder in buf}
buf := fldStr;
if (Pos(' ', buf) > 0) then
buf := '"' + tblName + '"."' + buf + '"';
idxStr := idxStr + buf;
{Now, create the TQuery and execute it.}
sqlIdx := TQuery.Create(Application);
with sqlIdx do begin
Active := False;
DatabaseName := dbName;
Sql.Clear;
Sql.Add('CREATE INDEX '+idxName+' ON ":'+dbName+':'+tblName+'" (' +idxStr+ ')');
SQL.SaveToFile('creatidx.sql');
try
try
ExecSql;
finally
Free;
end;
except
Abort;
end;
end;
end;
{type TIndexOptions = set of (ixPrimary, ixUnique, ixDescending,
ixExpression, ixCaseInsensitive)}
procedure IndexTbl(dbName, {Database Name to connect to}
tblName, {Table Name}
idxName, {Name of Index}
fldName : String; {List of Fields to index on}
idxOpts : TIndexOptions); {Index Options set}
var tbl : TTable;
begin
tbl := TTable.Create(Application);
with tbl do begin
Active := False;
DatabaseName := dbName;
TableName := tblName;
AddIndex(idxName, fldName, idxOpts, 'descript');
Free;
end;
end;
procedure PackTableKnabe;
var Table: TTable;
z: integer;
begin
Table:= TTable.Create(NIL);
with Table do begin
//databasename:= 'SASDaten';
databasename:= SCHOLZALIAS; //'Knabe2014';
//writeln('GetAliasPath: '+GetAliasPath(databasename));
//databasename:= 'cknabe';
tablename:= 'Auftrag.DB';
//tablename:= 'Auftrag.DB';
//tablename:= 'Skonto.DB';
//tablename:= 'AB.DB';
tabletype:= ttparadox;
active:= false;
Exclusive := true;
//writeln('indexes: '+booleantoString(TableRegenIndexes(table)))
// writeln('indexes: '+booleantoString(TableRegenIndexes(table)))
//Open;
//DoQuery(databasename, 'StatusMin');
// DoExecQuery2(databasename);
//for i:= 0 to Recordcount - 1 do begin
for z:= 0 to Fieldcount - 1 do begin
//Write((Fields[z].Fieldname)+': ');
Write((Fields[z].asString)+' ');
end;
//packtable(table)
AddIndex('AuftragsNrIdx', 'AuftragsNr',[ixPrimary,ixUnique],'');
//SetIndex(table, 'AuftragsNrIdx');
//RestoreIndex(table);
// ReindexTable(table);
writeln('indexes: '+booleantoString(TableRegenIndexes(table)))
if tablepacktable(table) then writeln('table packed finished');
close;
free;
end;
end;
const sLineBreak = CRLF;
procedure DatasetStreamtoCSV;
var
Stream: TFileStream;
i: Integer;
OutLine: string;
sTemp: string;
query1: TQuery;
begin
Stream := TFileStream.Create('C:\Data\YourFile.csv', fmCreate);
try
while not Query1.Eof do begin
// You'll need to add your special handling here where OutLine is built
OutLine := '';
for i := 0 to Query1.FieldCount - 1 do begin
sTemp := Query1.Fields[i].AsString;
// Special handling to sTemp here
OutLine := OutLine + sTemp + ',';
end;
// Remove final unnecessary ','
SetLength(OutLine, Length(OutLine) - 1);
// Write line to file
//sizeof(char) as 'C'
Stream.Write(OutLine[1], Length(OutLine) * SizeOf('C'));
// Write line ending
Stream.Write(sLineBreak, Length(sLineBreak));
Query1.Next;
end;
finally
Stream.Free; // Saves the file
end;
end;
//end;
// new para implementation
//makeresult is NTFS
{ if NtfsReparsePointsSupported(Extractfiledrive('C')+'\') then
writeln('NTFS supported');}
procedure WriteDataSetToCSV(DataSet: TDataSet; FileName: String);
var
List: TStringList;
S: String;
I: Integer;
begin
List := TStringList.Create;
try
DataSet.First;
while not DataSet.Eof do begin
S := '';
for I := 0 to DataSet.FieldCount - 1 do begin
if S > '' then
S := S + ',';
S := S + '"' + DataSet.Fields[I].AsString + '"';
end;
List.Add(S);
DataSet.Next;
end;
finally
List.SaveToFile(FileName);
List.Free;
end;
end;
procedure DoExecQuery3(aDB, aquery: string);
var dQuery: TQuery;
begin
dQuery:= TQuery.create(self);
with dQuery do begin
DatabaseName:= aDB;
try
try
writeln('');
writeln('exec the query for DB starts: ');
SQL.Clear;
SQL.Text:= aquery; //SQLQueryExec;
writeln('exec sql ready to run: ');
ExecSQL;
//Writeln(inttostr(RecordCount)+' Records found: ')
except
raiselastexception;
showmessagebig('E: exec query 32 raiselastexception');
writeln('E: exec query 2 raiselastexception');
end
finally
//raiselastexception;
Close;
Free;
showmessagebig('Exec query 32 end success!');
//CloseDataBase(aDB)
end;
end
end;
var locobj: TJvLocateObject;
procedure DoQuery2(aDB: string; aquery: string);
var i,z: integer;
dQuery: TQuery;
begin
dQuery:= TQuery.create(self);
with dQuery do begin
DatabaseName:= aDB;
try
//GetQuery(SQLQuery, dQuery)
SQL.Clear;
//SQL.Text:= 'select * from customer';
SQL.Text:= aquery; //SQLQuery;
Open;
Writeln(inttostr(RecordCount)+' Records found: ')
for i:= 0 to RecordCount - 1 do begin
for z:= 0 to Fieldcount - 1 do
// Write((Fields[z].asString)+' ');
//Writeln(intToStr(i)+' '+fieldbyname(afield).asString);
Writeln(intToStr(i)+' '+fields[z].asString);
Writeln('');
Next;
end;
//Export ExecSQL;
//if CreateOleObject('Excel.Application') <> ' ' then
//if GUIDToString(ProgIDToClassID('Excel.Application')) <> '' then
try
ProgIDToClassID('Excel.Application');
ExportDataSetToExcel(dquery, NIL);
except
writeln('No Excel found - write it to File: '+Exepath+DB_TABLENAME+'.txt');
//locobj:= CreateLocate(dquery);
//locobj.Free;
WriteDataSetToCSV(dquery, Exepath+DB_TABLENAME+'.txt');
OpenDoc(Exepath+DB_TABLENAME+'.txt');
end;
finally
Close;
Free;
//CloseDataBase(aDB)
end;
end
end;
procedure StartQuery(aquery: string; execute: boolean);
var Table: TTable;
z: integer;
begin
Table:= TTable.Create(NIL);
with Table do begin
//databasename:= 'SASDaten';
databasename:= SCHOLZALIAS; //'Knabe2014';
//writeln('GetAliasPath: '+GetAliasPath(databasename));
tabletype:= ttparadox;
//writeln('indexes: '+booleantoString(TableRegenIndexes(table)))
//Open;
// DoQuery2(databasename, aquery);
if execute then
DoExecQuery3(databasename, aquery) else
DoQuery2(databasename, aquery);
//for i:= 0 to Recordcount - 1 do begin
for z:= 0 to Fieldcount - 1 do begin
//Write((Fields[z].Fieldname)+': ');
Write((Fields[z].asString)+' ');
end;
//packtable(table)
{ writeln('indexes: '+booleantoString(TableRegenIndexes(table)))
if tablepacktable(table) then writeln('table packed finished');}
close;
free;
end;
end;
procedure getAliasNames2;
var mylst: TStringlist;
i: integer;
begin
mylst:= TStringlist.create;
with TSession.Create(NIL) do try
SessionName:= 'Mars3'
getAliasNames(mylst);
Writeln('BDE / DB Alias Driver List: ******************************');
for i:= 0 to mylst.count-1 do begin
writeln(mylst[i]+': '+GetAliasDriverName(mylst[i]));
writeln(GetAliasPath(mylst[i]));
end;
finally
Free;
mylst.Free;
end;
end;
var
//ww: wchar;
//wa: ansichar;
wp: pchar;
app: ___Pointer;
begin
memo2.font.size:= 14;
//SetForm;
//mymemo.lines.text:= getRandomText;
//SearchAndOpenDoc(ExePath+MEDIAPATH)
//mylistview:= TFormListView.Create(self);
//exit;
maxform1.color:= clsilver;
//ansitonative
//displaystream
//SQLAddWhere
//prettynametocolor
//RGBToHSV
// hasanychar
//writestringtostream
//ansichar
//pathdelim
//invalidaterect
//replacestring
//stringtoboolean
//killmessage
//getshellstring
//lzfileexpand;
//booltostrJ
//strlicomp
//posstr
//iszero
writeln(inttostr(swapint(10)))
//smallpointtopoint
//nullrect
//CreateMappedBmp
//Truntimeerror
//app:= inFrm;
//SetMultiByteConversionCodePage
//writeln(inttostr(modulecacheid))
JCLStringsTester;
bigstring:= getRandomText;
Saveln(exepath+'saveyourservants.txt',bigstring);
//maxForm1.tbtnUseCaseClick(self);
// packtable(G:\Knabe\backupmarch2014\Aufpos1.DB);
//OpenDir('C:\maXbook\scholz\bergfeld3\Daten\');
// OpenFile('C:\maXbook\scholz\SAS2\TIM.exe');
//OpenFile('C:\Program Files (x86)\Borland\Common Files\BDE\BDEADMIN.EXE');
getAliasNames2;
//StartQuery(SQLQuery, false);
//StartQuery(SQLQuery3, false);
//StartQuery(SQLQueryExec1, true);
//StartQuery(SQLQueryExec2, true);
// StartQuery(SQLQueryExec3, true);
//StartQuery(SQLQueryExec4, true);
//StartQuery(SQLQueryExec5, true);
//StartQuery(SQLQueryExec6, true);
//StartQuery(SQLQueryExec7, true);
//StartQuery(SQLQueryExec8, true);
//StartQuery(SQLQueryExec9, true);
//StartQuery(SQLQueryExec10, true);
//StartQuery(SQLQueryExec11, true);
//StartQuery(SQLQueryExec12, true);
//StartQuery(SQLQueryExec13, true);
//StartQuery(SQLQueryExec14, true);
//StartQuery(SQLQueryExec15, true);
//StartQuery(SQLQueryExec16, true);
//StartQuery(SQLQueryExec25, true);
//StartQuery(SQLQueryExec36, true);
//StartQuery(SQLQueryExec40, true);
//StartQuery(SQLQueryExec41, true);
{StartQuery(SQLQueryExec42, true);
StartQuery(SQLQueryExec43, true);
StartQuery(SQLQueryExec44, true); }
//StartQuery(SQLQueryExec45, true);
// StartQuery(SQLQueryExec40, true);
if QuerySWITCH then
StartQuery(SQLQuery, false) else
StartQuery(SQLQueryExec, true); //true is exec
//StartQuery(SQLQuery, false);
//OpenFile('C:\maXbook\scholz\SAS2\TIM.exe');
//OpenFile('C:\maXbook\scholz\SAS2\SAS\TIM.exe');
//PackTableKnabe;
End.
Question:
I am attempting to add data to my Paradox table but I'm getting the Error "Table is Full". What is the cause of this and how can I add more records?
Answer:
Paradox tables have a block size which determines the maximum record size for a table and the table's maximum size. By default tables have a block size of 4K. Regardless of the block size, tables can have a maximum of 64K blocks. This means by default a table can grow to 256 MB.
You can increase the block size of a table in 1 of two ways.
Run BDE Admin and change the block size for the Paradox driver to a revised number. Legal block sizes are 1024, 2048, 4096, 16384 and 32768. If your block size is larger then 4096 then you must also change level to be at least 5. Finally, create a new table and batchmove your data from your old table to your new table
It is possible to change the block size of an existing table by calling dbiDoRestucture. For an example see www.borland.com/devsupport/bde/files/pxrest.zip
http://www.devx.com/tips/Tip/23627
Navigate to the BDEAdmin.exe (located in the "Program Files\Cyrious\Common\BDE\" folder)
Go to Configuration
Drill down to Native
Drill down to Paradox
Increase the block size to 8192 or 4096
Set the level to at least 5
Rebuild the database
Create Table "GL Database.DB"
(
ID Integer,
StoreID Integer,
DateTime TimeStamp,
OrderID Integer,
CustomerID Integer,
RecordID Integer,
AccountCode Integer,
UserID Integer,
Amount Money,
Description Char(25),
Closed Boolean,
ClosedDate TimeStamp,
Exported Boolean,
ExportedDate TimeStamp,
ExportedBatch Integer,
EnteredByID Integer,
SubaccountCode Integer,
Taxable Boolean,
Consolidated Boolean,
Category Integer,
RoyaltyGroupID Integer,
ModifiedByComputer Char(25),
ModifiedDate TimeStamp,
OrderDetailID Integer,
ProductID Integer,
PRIMARY KEY (ID)
)
;
CREATE INDEX AccountCodeIndex ON "GL Database" (AccountCode)
;
CREATE INDEX OrderIndex ON "GL Database" (OrderID)
;
CREATE INDEX ModifiedDateIndex ON "GL Database" (ModifiedDate)
;
CREATE INDEX OrderDetailIDIndex ON "GL Database" (OrderDetailID)
;
CREATE INDEX ProductIDIndex ON "GL Database" (ProductID)
;
Run query to import data from the old table to the new table
// FOR Example
INSERT INTO "Order Details Database"
SELECT * FROM "ODD"
;
// FOR Example
INSERT INTO "GL Database"
SELECT * FROM "GL"
;
//-------------------------------------------------
source is tlistview
target is tform
procedure TfMerit.SourceLVStartDrag(Sender: TObject;
var DragObject: TDragObject);
var TargetLV:TListView;
begin
// TargetLV:=nejak urcit dle potreby
TargetLV.BeginDrag(True)
end;
procedure TfMerit.SourceLVMouseDown(Sender: TObject;
Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
MouseIsDown:=True;
end;
procedure TfMerit.SourceLVMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
MouseIsDown:=False;
if (Sender as TListView).Dragging then
(Sender as TListView).EndDrag(False);
end;
procedure TfMerit.SourceLVMouseMove(Sender: TObject; Shift: TShiftState;
X, Y: Integer);
begin
if (Sender.ClassNameIs('TListView')) then
begin
if MouseIsDown and ((Sender as TListView).SelCount>0) then
(Sender as TListView).BeginDrag(True);
end;
end;
procedure TfMerit.TargetLVDragOver(Sender, Source: TObject; X,
Y: Integer; State: TDragState; var Accept: Boolean);
var T:TListView;
begin
T:=Sender as TListView;
Accept:=Assigned(T.GetItemAt(X,Y));
end;
procedure TfMerit.TargetLVDragDrop(Sender, Source: TObject; X,
Y: Integer);
var It:TListItem;
LV1,LV2:TListView;
begin
LV1:=Source as TListView;
LV2:=Sender as TListview;
It:=LV2.GetItemAt(X,Y);
if Assigned(It) then
begin
// zpracuj polozku ze zdrojoveho listview
end;
end;
procedure jclstringstester;
begin
{template s}
ReplaceFirst(const SourceStr, FindStr, ReplaceStr: string): string;
ReplaceLast(const SourceStr, FindStr, ReplaceStr: string): string;
InsertLastBlock(var SourceStr: string; BlockStr: string): Boolean;
RemoveMasterBlocks(const SourceStr: string): string;
RemoveFields(const SourceStr: string): string;
{http s}
URLEncode(const Value: AnsiString): AnsiString; // Converts string To A URLEncoded string
URLDecode(const Value: AnsiString): AnsiString; // Converts string From A URLEncoded string
{set s}
procedure SplitSet(AText: string; AList: TStringList);
JoinSet(AList: TStringList): string;
FirstOfSet(const AText: string): string;
LastOfSet(const AText: string): string;
CountOfSet(const AText: string): Integer;
SetRotateRight(const AText: string): string;
SetRotateLeft(const AText: string): string;
SetPick(const AText: string; AIndex: Integer): string;
SetSort(const AText: string): string;
SetUnion(const Set1, Set2: string): string;
SetIntersect(const Set1, Set2: string): string;
SetExclude(const Set1, Set2: string): string;
{replace any <,> etc by < >}
XMLSafe(const AText: string): string;
{simple hash, Result can be used in Encrypt}
Hash(const AText: string): Integer;
{ Base64 encode and decode a string }
B64Encode(const S: AnsiString): AnsiString;
B64Decode(const S: AnsiString): AnsiString;
{Basic encryption from a Borland Example}
Encrypt(const InString: AnsiString; StartKey, MultKey, AddKey: Integer): AnsiString;
Decrypt(const InString: AnsiString; StartKey, MultKey, AddKey: Integer): AnsiString;
{Using Encrypt and Decrypt in combination with B64Encode and B64Decode}
EncryptB64(const InString: AnsiString; StartKey, MultKey, AddKey: Integer): AnsiString;
DecryptB64(const InString: AnsiString; StartKey, MultKey, AddKey: Integer): AnsiString;
procedure CSVToTags(Src, Dst: TStringList);
// converts a csv list to a tagged string list
procedure TagsToCSV(Src, Dst: TStringList);
// converts a tagged string list to a csv list
// only fieldnames from the first record are scanned ib the other records
procedure ListSelect(Src, Dst: TStringList; const AKey, AValue: string);
{selects akey=avalue from Src and returns recordset in Dst}
procedure ListFilter(Src: TStringList; const AKey, AValue: string);
{filters Src for akey=avalue}
procedure ListOrderBy(Src: TStringList; const AKey: string; Numeric: Boolean);
{orders a tagged Src list by akey}
PosStr(const FindString, SourceString: string;
StartPos: Integer = 1): Integer;
{ PosStr searches the first occurrence of a substring FindString in a string
given by SourceString with case sensitivity (upper and lower case characters
are differed). This returns the index value of the first character
of a specified substring from which it occurs in a given string starting with
StartPos character index. If a specified substring is not found Q_PosStr
returns zero. The author of algorithm is Peter Morris (UK) (Faststrings unit
from www.torry.ru). }
PosStrLast(const FindString, SourceString: string): Integer;
{finds the last occurance}
LastPosChar(const FindChar: Char; SourceString: string): Integer;
PosText(const FindString, SourceString: string;
StartPos: Integer = 1): Integer;
{ PosText searches the first occurrence of a substring FindString in a string
given by SourceString without case sensitivity (upper and lower case
characters are not differed). This returns the index value of the
first character of a specified substring from which it occurs in a given
string starting with StartPos character index. If a specified substring is
not found Q_PosStr returns zero. The author of algorithm is Peter Morris
(UK) (Faststrings unit from www.torry.ru). }
PosTextLast(const FindString, SourceString: string): Integer;
{finds the last occurance}
NameValuesToXML(const AText: string): string;
{$IFDEF MSWINDOWS}
procedure LoadResourceFile(AFile: string; MemStream: TMemoryStream);
{$ENDIF MSWINDOWS}
procedure DirFiles(const ADir, AMask: string; AFileList: TStringList);
procedure RecurseDirFiles(const ADir: string; var AFileList: TStringList);
procedure RecurseDirProgs(const ADir: string; var AFileList: TStringList);
procedure SaveString(const AFile, AText: string);
LoadString(const AFile: string): string;
HexToColor(const AText: string): TColor;
UppercaseHTMLTags(const AText: string): string;
LowercaseHTMLTags(const AText: string): string;
procedure GetHTMLAnchors(const AFile: string; AList: TStringList);
RelativePath(const ASrc, ADst: string): string;
GetToken(var Start: Integer; const SourceText: string): string;
PosNonSpace(Start: Integer; const SourceText: string): Integer;
PosEscaped(Start: Integer; const SourceText, FindText: string; EscapeChar: Char): Integer;
DeleteEscaped(const SourceText: string; EscapeChar: Char): string;
BeginOfAttribute(Start: Integer; const SourceText: string): Integer;
// parses the beginning of an attribute: space + alpha character
ParseAttribute(var Start: Integer; const SourceText: string; var AName, AValue: string): Boolean;
// parses a name="value" attribute from Start; returns 0 when not found or else the position behind the attribute
procedure ParseAttributes(const SourceText: string; Attributes: TStrings);
// parses all name=value attributes to the attributes TStringList
HasStrValue(const AText, AName: string; var AValue: string): Boolean;
// checks if a name="value" pair exists and returns any value
GetStrValue(const AText, AName, ADefault: string): string;
// retrieves string value from a line like:
// name="jan verhoeven" email="jan1 dott verhoeven att wxs dott nl"
// returns ADefault when not found
GetHTMLColorValue(const AText, AName: string; ADefault: TColor): TColor;
// same for a color
GetIntValue(const AText, AName: string; ADefault: Integer): Integer;
// same for an Integer
GetFloatValue(const AText, AName: string; ADefault: Extended): Extended;
// same for a float
GetBoolValue(const AText, AName: string): Boolean;
// same for Boolean but without default
GetValue(const AText, AName: string): string;
// retrieves string value from a line like:
// name="jan verhoeven" email="jan1 dott verhoeven att wxs dott nl"
procedure SetValue(var AText: string; const AName, AValue: string);
// sets a string value in a line
procedure DeleteValue(var AText: string; const AName: string);
// deletes a AName="value" pair from AText
procedure GetNames(AText: string; AList: TStringList);
// get a list of names from a string with name="value" pairs
GetHTMLColor(AColor: TColor): string;
// converts a color value to the HTML hex value
BackPosStr(Start: Integer; const FindString, SourceString: string): Integer;
// finds a string backward case sensitive
BackPosText(Start: Integer; const FindString, SourceString: string): Integer;
// finds a string backward case insensitive
PosRangeStr(Start: Integer; const HeadString, TailString, SourceString: string;
var RangeBegin: Integer; var RangeEnd: Integer): Boolean;
// finds a text range, e.g. .... | case sensitive
PosRangeText(Start: Integer; const HeadString, TailString, SourceString: string;
var RangeBegin: Integer; var RangeEnd: Integer): Boolean;
// finds a text range, e.g. .... | case insensitive
BackPosRangeStr(Start: Integer; const HeadString, TailString, SourceString: string;
var RangeBegin: Integer; var RangeEnd: Integer): Boolean;
// finds a text range backward, e.g. .... | case sensitive
BackPosRangeText(Start: Integer; const HeadString, TailString, SourceString: string;
var RangeBegin: Integer; var RangeEnd: Integer): Boolean;
// finds a text range backward, e.g. .... | case insensitive
PosTag(Start: Integer; SourceString: string; var RangeBegin: Integer;
var RangeEnd: Integer): Boolean;
// finds a HTML or XML tag: <....>
InnerTag(Start: Integer; const HeadString, TailString, SourceString: string;
var RangeBegin: Integer; var RangeEnd: Integer): Boolean;
// finds the innertext between opening and closing tags
Easter(NYear: Integer): TDateTime;
// returns the easter date of a year.
GetWeekNumber(Today: TDateTime): string;
//gets a datecode. Returns year and weeknumber in format: YYWW
ParseNumber(const S: string): Integer;
// parse number returns the last position, starting from 1
ParseDate(const S: string): Integer;
// parse a SQL style data string from positions 1,
// starts and ends with #
end;
procedure TControlParentR(Self:TControl;var T:TWinControl); begin T:= Self.Parent; end;
procedure TControlParentW(Self: TControl; T: TWinControl); begin Self.Parent:= T; end;
RegisterPropertyHelper(@TControlParentR, @TControlParentW, 'PARENT');
RegisterProperty('Parent', 'TWinControl', iptRW);
procedure TTXPTool.LVPFFDblClick(Sender: TObject);
var
tmpList : TListItem;
fn ; string;
ft : integer;
fs : integer;
begin
tmpList := LVPFF.Selected;
if tmplist<>nil then
begin
fn := tmpList.Caption
ft := tmpList.SubItems.Strings[1];
fs := tmpList.SubItems.Strings[3];
if pos('Wave', ft)>0 then
PlayThisOne1Click(nil);
if pos('Jpg', ft)>0 then
ShowJpg1Click(nil);
if pos('Targa', ft)>0 then
ShowTga1Click(nil);
if pos('Pcx', ft)>0 then
ShowPcx1Click(nil);
if pos('Mission Sound Collection', ft)>0 then
ShowPwf1Click(nil);
end;
end;
procedure jclutilsnewtest;
begin
function VarIsInt(Value: Variant): Boolean;
// VarIsInt returns VarIsOrdinal-[varBoolean]
{ PosIdx returns the index of the first appearance of SubStr in Str. The search
starts at index "Index". }
function PosIdx(const SubStr, S: string; Index: Integer = 0): Integer;
function PosIdxW(const SubStr, S: WideString; Index: Integer = 0): Integer;
function PosLastCharIdx(Ch: Char; const S: string; Index: Integer = 0): Integer;
{ GetWordOnPos returns Word from string, S, on the cursor position, P}
function GetWordOnPos(const S: string; const P: Integer): string;
function GetWordOnPosW(const S: WideString; const P: Integer): WideString;
function GetWordOnPos2(const S: string; P: Integer; var iBeg, iEnd: Integer): string;
function GetWordOnPos2W(const S: WideString; P: Integer; var iBeg, iEnd: Integer): WideString;
{ GetWordOnPosEx working like GetWordOnPos function, but
also returns Word position in iBeg, iEnd variables }
function GetWordOnPosEx(const S: string; const P: Integer; var iBeg, iEnd: Integer): string;
function GetWordOnPosExW(const S: WideString; const P: Integer; var iBeg, iEnd: Integer): WideString;
function GetNextWordPosEx(const Text: string; StartIndex: Integer;
var iBeg, iEnd: Integer): string;
function GetNextWordPosExW(const Text: WideString; StartIndex: Integer;
var iBeg, iEnd: Integer): WideString;
procedure GetEndPosCaret(const Text: string; CaretX, CaretY: Integer;
var X, Y: Integer);
{ GetEndPosCaret returns the caret position of the last char. For the position
after the last char of Text you must add 1 to the returned X value. }
procedure GetEndPosCaretW(const Text: WideString; CaretX, CaretY: Integer;
var X, Y: Integer);
{ GetEndPosCaret returns the caret position of the last char. For the position
after the last char of Text you must add 1 to the returned X value. }
{ SubStrBySeparator returns substring from string, S, separated with Separator string}
function SubStrBySeparator(const S: string; const Index: Integer; const Separator: string; StartIndex: Integer = 1): string;
function SubStrBySeparatorW(const S: WideString; const Index: Integer; const Separator: WideString; StartIndex: Integer = 1): WideString;
{ SubStrEnd same to previous function but Index numerated from the end of string }
//function SubStrEnd(const S: string; const Index: Integer; const Separator: string): string;
{ SubWord returns next Word from string, P, and offsets Pointer to the end of Word, P2 }
function SubWord(P: PChar; var P2: PChar): string;
// function CurrencyByWord(Value: Currency): string;
{ GetLineByPos returns the Line number, there
the symbol Pos is pointed. Lines separated with #13 symbol }
function GetLineByPos(const S: string; const Pos: Integer): Integer;
{ GetXYByPos is same as GetLineByPos, but returns X position in line as well}
procedure GetXYByPos(const S: string; const Pos: Integer; var X, Y: Integer);
procedure GetXYByPosW(const S: WideString; const Pos: Integer; var X, Y: Integer);
{ ReplaceString searches for all substrings, OldPattern,
in a string, S, and replaces them with NewPattern }
function ReplaceString(S: string; const OldPattern, NewPattern: string; StartIndex: Integer = 1): string;
function ReplaceStringW(S: WideString; const OldPattern, NewPattern: WideString; StartIndex: Integer = 1): WideString;
{ ConcatSep concatenate S1 and S2 strings with Separator.
if S = '' then separator not included }
function ConcatSep(const S1, S2, Separator: string): string; {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF SUPPORTS_INLINE}
{ ConcatLeftSep is same to previous function, but
strings concatenate right to left }
function ConcatLeftSep(const S1, S2, Separator: string):string;{$IFDEF SUPPORTS_INLINE} inline; {$ENDIF SUPPORTS_INLINE}
{ Next 4 function for russian chars transliterating.
This functions are needed because Oem2Ansi and Ansi2Oem functions
sometimes suck }
procedure Dos2Win(var S: AnsiString);
procedure Win2Dos(var S: AnsiString);
function Dos2WinRes(const S: AnsiString): AnsiString; {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF SUPPORTS_INLINE}
function Win2DosRes(const S: AnsiString): AnsiString; {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF SUPPORTS_INLINE}
function Win2Koi(const S: AnsiString): AnsiString;
{ FillString fills the string Buffer with Count Chars }
procedure FillString(var Buffer: string; Count: Integer; const Value: Char); overload;
procedure FillString(var Buffer: string; StartIndex, Count: Integer; const Value: Char); overload;
{ MoveString copies Count Chars from Source to Dest }
procedure MoveString(const Source: string; var Dest: string; Count: Integer); {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF SUPPORTS_INLINE} overload;
procedure MoveString(const Source: string; SrcStartIdx: Integer; var Dest: string;
DstStartIdx: Integer; Count: Integer); {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF SUPPORTS_INLINE} overload;
{ FillWideChar fills Buffer with Count WideChars (2 Bytes) }
procedure FillWideChar(var Buffer; Count: Integer; const Value: WideChar);
{ MoveWideChar copies Count WideChars from Source to Dest }
procedure MoveWideChar(const Source; var Dest; Count: Integer); {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF SUPPORTS_INLINE}
{ FillNativeChar fills Buffer with Count NativeChars }
procedure FillNativeChar(var Buffer; Count: Integer; const Value: Char); // D2009 internal error {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF SUPPORTS_INLINE}
{ MoveWideChar copies Count WideChars from Source to Dest }
procedure MoveNativeChar(const Source; var Dest; Count: Integer); // D2009 internal error {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF SUPPORTS_INLINE}
{ IsSubString() compares the sub string to the string. Indices are 1th based. }
function IsSubString(const S: string; StartIndex: Integer; const SubStr: string): Boolean;
{ Spaces returns string consists on N space chars }
function Spaces(const N: Integer): string;
{ AddSpaces adds spaces to string S, if its Length is smaller than N }
function AddSpaces(const S: string; const N: Integer): string;
function SpacesW(const N: Integer): WideString;
function AddSpacesW(const S: WideString; const N: Integer): WideString;
{ function LastDateRUS for russian users only }
{ returns date relative to current date: 'два дня назад' }
function LastDateRUS(const Dat: TDateTime): string;
{ CurrencyToStr format Currency, Cur, using ffCurrency float format}
function CurrencyToStr(const Cur: Currency): string;
{ HasChar returns True, if Char, Ch, contains in string, S }
function HasChar(const Ch: Char; const S: string): Boolean;
function HasCharW(const Ch: WideChar; const S: WideString): Boolean; {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF SUPPORTS_INLINE}
function HasAnyChar(const Chars: string; const S: string): Boolean;
{$IFNDEF COMPILER12_UP}
function CharInSet(const Ch: AnsiChar; const SetOfChar: TSysCharSet): Boolean; {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF SUPPORTS_INLINE}
{$ENDIF ~COMPILER12_UP}
function CharInSetW(const Ch: WideChar; const SetOfChar: TSysCharSet): Boolean; {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF SUPPORTS_INLINE}
function CountOfChar(const Ch: Char; const S: string): Integer;
function DefStr(const S: string; Default: string): string; {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF SUPPORTS_INLINE}
{ StrLICompW2 is a faster replacement for JclUnicode.StrLICompW }
function StrLICompW2(S1, S2: PWideChar; MaxLen: Integer): Integer;
function StrPosW(S, SubStr: PWideChar): PWideChar;
function StrLenW(S: PWideChar): Integer;
function TrimW(const S: WideString): WideString; {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF SUPPORTS_INLINE}
function TrimLeftW(const S: WideString): WideString; {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF SUPPORTS_INLINE}
function TrimRightW(const S: WideString): WideString; {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF SUPPORTS_INLINE}
{**** files routines}
procedure SetDelimitedText(List: TStrings; const Text: string; Delimiter: Char);
{ GenTempFileName returns temporary file name on
drive, there FileName is placed }
function GenTempFileName(FileName: string): string;
{ GenTempFileNameExt same to previous function, but
returning filename has given extension, FileExt }
function GenTempFileNameExt(FileName: string; const FileExt: string): string;
{ ClearDir clears folder Dir }
function ClearDir(const Dir: string): Boolean;
{ DeleteDir clears and than delete folder Dir }
function DeleteDir(const Dir: string): Boolean;
{ FileEquMask returns True if file, FileName,
is compatible with given dos file mask, Mask }
function FileEquMask(FileName, Mask: TFileName;
CaseSensitive: Boolean = DefaultCaseSensitivity): Boolean;
{ FileEquMasks returns True if file, FileName,
is compatible with given Masks.
Masks must be separated with SepPath (MSW: ';' / UNIX: ':') }
function FileEquMasks(FileName, Masks: TFileName;
CaseSensitive: Boolean = DefaultCaseSensitivity): Boolean;
function DeleteFiles(const Folder: TFileName; const Masks: string): Boolean;
{$IFDEF MSWINDOWS}
{ LZFileExpand expand file, FileSource,
into FileDest. Given file must be compressed, using MS Compress program }
function LZFileExpand(const FileSource, FileDest: string): Boolean;
{$ENDIF MSWINDOWS}
{ FileGetInfo fills SearchRec record for specified file attributes}
function FileGetInfo(FileName: TFileName; var SearchRec: TSearchRec): Boolean;
{ HasSubFolder returns True, if folder APath contains other folders }
function HasSubFolder(APath: TFileName): Boolean;
{ IsEmptyFolder returns True, if there are no files or
folders in given folder, APath}
function IsEmptyFolder(APath: TFileName): Boolean;
{ AddSlash returns string with added slash Char to Dir parameter, if needed }
function AddSlash(const Dir: TFileName): string; {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF SUPPORTS_INLINE}
{ AddPath returns FileName with Path, if FileName not contain any path }
function AddPath(const FileName, Path: TFileName): TFileName;
function AddPaths(const PathList, Path: string): string;
function ParentPath(const Path: TFileName): TFileName;
function FindInPath(const FileName, PathList: string): TFileName;
{ DeleteReadOnlyFile clears R/O file attribute and delete file }
function DeleteReadOnlyFile(const FileName: TFileName): Boolean;
{ HasParam returns True, if program running with specified parameter, Param }
function HasParam(const Param: string): Boolean;
function HasSwitch(const Param: string): Boolean;
function Switch(const Param: string): string;
{ ExePath returns ExtractFilePath(ParamStr(0)) }
function ExePath: TFileName; {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF SUPPORTS_INLINE}
function CopyDir(const SourceDir, DestDir: TFileName): Boolean;
//function FileTimeToDateTime(const FT: TFileTime): TDateTime;
procedure FileTimeToDosDateTimeDWord(const FT: TFileTime; out Dft: DWORD);
function MakeValidFileName(const FileName: TFileName; ReplaceBadChar: Char): TFileName;
{**** Graphic routines }
{ IsTTFontSelected returns True, if True Type font
is selected in specified device context }
function IsTTFontSelected(const DC: HDC): Boolean;
function KeyPressed(VK: Integer): Boolean;
{ TrueInflateRect inflates rect in other method, than InflateRect API function }
function TrueInflateRect(const R: TRect; const I: Integer): TRect;
{**** Color routines }
procedure RGBToHSV(R, G, B: Integer; var H, S, V: Integer);
function RGBToBGR(Value: Cardinal): Cardinal;
//function ColorToPrettyName(Value: TColor): string;
//function PrettyNameToColor(const Value: string): TColor;
{**** other routines }
procedure SwapInt(var Int1, Int2: Integer); {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF SUPPORTS_INLINE}
function IntPower(Base, Exponent: Integer): Integer;
function ChangeTopException(E: TObject): TObject; // Linux version writes error message to ErrOutput
function StrToBool(const S: string): Boolean;
function Var2Type(V: Variant; const DestVarType: Integer): Variant;
function VarToInt(V: Variant): Integer;
function VarToFloat(V: Variant): Double;
{ following functions are not documented
because they do not work properly sometimes, so do not use them }
// (rom) ReplaceStrings1, GetSubStr removed
function GetLongFileName(const FileName: string): string;
function FileNewExt(const FileName, NewExt: TFileName): TFileName;
function GetParameter: string;
function GetComputerID: string;
function GetComputerName: string;
{**** string routines }
{ ReplaceAllStrings searches for all substrings, Words,
in a string, S, and replaces them with Frases with the same Index. }
function ReplaceAllStrings(const S: string; Words, Frases: TStrings): string;
{ ReplaceStrings searches the Word in a string, S, on PosBeg position,
in the list, Words, and if founds, replaces this Word
with string from another list, Frases, with the same Index,
and then update NewSelStart variable }
function ReplaceStrings(const S: string; PosBeg, Len: Integer; Words, Frases: TStrings; var NewSelStart: Integer): string;
{ CountOfLines calculates the lines count in a string, S,
each line must be separated from another with CrLf sequence }
function CountOfLines(const S: string): Integer;
{ DeleteLines deletes all lines from strings which in the words, words.
The word of will be deleted from strings. }
procedure DeleteOfLines(Ss: TStrings; const Words: array of string);
{ DeleteEmptyLines deletes all empty lines from strings, Ss.
Lines contained only spaces also deletes. }
procedure DeleteEmptyLines(Ss: TStrings);
{ SQLAddWhere addes or modifies existing where-statement, where,
to the strings, SQL.
Note: If strings SQL allready contains where-statement,
it must be started on the begining of any line }
procedure SQLAddWhere(SQL: TStrings; const Where: string);
{**** files routines - }
{$IFDEF MSWINDOWS}
{ ResSaveToFile save resource named as Name with Typ type into file FileName.
Resource can be compressed using MS Compress program}
function ResSaveToFile(const Typ, Name: string; const Compressed: Boolean; const FileName: string): Boolean;
function ResSaveToFileEx(Instance: HINST; Typ, Name: PChar;
const Compressed: Boolean; const FileName: string): Boolean;
function ResSaveToString(Instance: HINST; const Typ, Name: string;
var S: string): Boolean;
{$ENDIF MSWINDOWS}
{ IniReadSection read section, Section, from ini-file,
IniFileName, into strings, Ss.
This function reads ALL strings from specified section.
Note: TIninFile.ReadSection function reads only strings with '=' symbol.}
function IniReadSection(const IniFileName: TFileName; const Section: string; Ss: TStrings): Boolean;
{ LoadTextFile load text file, FileName, into string }
function LoadTextFile(const FileName: TFileName): string;
procedure SaveTextFile(const FileName: TFileName; const Source: string);
{ ReadFolder reads files list from disk folder, Folder,
that are equal to mask, Mask, into strings, FileList}
function ReadFolder(const Folder, Mask: TFileName; FileList: TStrings): Integer;
function ReadFolders(const Folder: TFileName; FolderList: TStrings): Integer;
{ RATextOut same with TCanvas.TextOut procedure, but
can clipping drawing with rectangle, RClip. }
procedure RATextOut(Canvas: TCanvas; const R, RClip: TRect; const S: string);
{ RATextOutEx same with RATextOut function, but
can calculate needed height for correct output }
function RATextOutEx(Canvas: TCanvas; const R, RClip: TRect; const S: string; const CalcHeight: Boolean): Integer;
{ RATextCalcHeight calculate needed height for
correct output, using RATextOut or RATextOutEx functions }
function RATextCalcHeight(Canvas: TCanvas; const R: TRect; const S: string): Integer;
{ Cinema draws some visual effect }
procedure Cinema(Canvas: TCanvas; rS {Source}, rD {Dest}: TRect);
{ Roughed fills rect with special 3D pattern }
procedure Roughed(ACanvas: TCanvas; const ARect: TRect; const AVert: Boolean);
{ BitmapFromBitmap creates new small bitmap from part
of source bitmap, SrcBitmap, with specified width and height,
AWidth, AHeight and placed on a specified Index, Index in the
source bitmap }
function BitmapFromBitmap(SrcBitmap: TBitmap; const AWidth, AHeight, Index: Integer): TBitmap;
{ TextWidth calculate text with for writing using standard desktop font }
function TextWidth(const AStr: string): Integer;
{ TextHeight calculate text height for writing using standard desktop font }
function TextHeight(const AStr: string): Integer;
procedure SetChildPropOrd(Owner: TComponent; const PropName: string; Value: Longint);
procedure Error(const Msg: string);
procedure ItemHtDrawEx(Canvas: TCanvas; Rect: TRect;
const State: TOwnerDrawState; const Text: string;
const HideSelColor: Boolean; var PlainItem: string;
var Width: Integer; CalcWidth: Boolean);
{ example for Text parameter :
'Item 1 bold italic ITALIC red green blue ' }
function ItemHtDraw(Canvas: TCanvas; Rect: TRect;
const State: TOwnerDrawState; const Text: string;
const HideSelColor: Boolean): string;
function ItemHtWidth(Canvas: TCanvas; Rect: TRect;
const State: TOwnerDrawState; const Text: string;
const HideSelColor: Boolean): Integer;
function ItemHtPlain(const Text: string): string;
{ ClearList - clears list of TObject }
procedure ClearList(List: TList);
procedure MemStreamToClipBoard(MemStream: TMemoryStream; const Format: Word);
procedure ClipBoardToMemStream(MemStream: TMemoryStream; const Format: Word);
{ RTTI support }
function GetPropType(Obj: TObject; const PropName: string): TTypeKind;
function GetPropStr(Obj: TObject; const PropName: string): string;
function GetPropOrd(Obj: TObject; const PropName: string): Integer;
function GetPropMethod(Obj: TObject; const PropName: string): TMethod;
procedure PrepareIniSection(Ss: TStrings);
{ following functions are not documented because
they are don't work properly, so don't use them }
// (rom) from JvBandWindows to make it obsolete
function PointL(const X, Y: Longint): TPointL; {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF SUPPORTS_INLINE}
// (rom) from JvBandUtils to make it obsolete
function iif(const Test: Boolean; const ATrue, AFalse: Variant): Variant; {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF SUPPORTS_INLINE}
procedure CopyIconToClipboard(Icon: TIcon; BackColor: TColor);
function CreateIconFromClipboard: TIcon;
{ begin JvIconClipboardUtils }
{ Icon clipboard routines }
function CF_ICON: Word;
procedure AssignClipboardIcon(Icon: TIcon);
{ Real-size icons support routines (32-bit only) }
procedure GetIconSize(Icon: HICON; var W, H: Integer);
function CreateRealSizeIcon(Icon: TIcon): HICON;
procedure DrawRealSizeIcon(Canvas: TCanvas; Icon: TIcon; X, Y: Integer);
{end JvIconClipboardUtils }
function CreateScreenCompatibleDC: HDC;
function InvalidateRect(hWnd: HWND; const lpRect: TRect; bErase: BOOL): BOOL; overload; {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF}
function InvalidateRect(hWnd: HWND; lpRect: PRect; bErase: BOOL): BOOL; overload; {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF}
{ begin JvRLE }
// (rom) changed API for inclusion in JCL
procedure RleCompressTo(InStream, OutStream: TStream);
procedure RleDecompressTo(InStream, OutStream: TStream);
procedure RleCompress(Stream: TStream);
procedure RleDecompress(Stream: TStream);
{ end JvRLE }
{ begin JvDateUtil }
function CurrentYear: Word; {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF SUPPORTS_INLINE}
function IsLeapYear(AYear: Integer): Boolean;
function DaysInAMonth(const AYear, AMonth: Word): Word;
function DaysPerMonth(AYear, AMonth: Integer): Integer;
function FirstDayOfPrevMonth: TDateTime;
function LastDayOfPrevMonth: TDateTime;
function FirstDayOfNextMonth: TDateTime;
function ExtractDay(ADate: TDateTime): Word;
function ExtractMonth(ADate: TDateTime): Word;
function ExtractYear(ADate: TDateTime): Word;
function IncDate(ADate: TDateTime; Days, Months, Years: Integer): TDateTime;
function IncDay(ADate: TDateTime; Delta: Integer): TDateTime; {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF SUPPORTS_INLINE}
function IncMonth(ADate: TDateTime; Delta: Integer): TDateTime;
function IncYear(ADate: TDateTime; Delta: Integer): TDateTime;
function ValidDate(ADate: TDateTime): Boolean;
procedure DateDiff(Date1, Date2: TDateTime; var Days, Months, Years: Word);
function MonthsBetween(Date1, Date2: TDateTime): Double;
function DaysInPeriod(Date1, Date2: TDateTime): Longint;
{ Count days between Date1 and Date2 + 1, so if Date1 = Date2 result = 1 }
function DaysBetween(Date1, Date2: TDateTime): Longint;
{ The same as previous but if Date2 < Date1 result = 0 }
function IncTime(ATime: TDateTime; Hours, Minutes, Seconds, MSecs: Integer): TDateTime;
function IncHour(ATime: TDateTime; Delta: Integer): TDateTime;
function IncMinute(ATime: TDateTime; Delta: Integer): TDateTime;
function IncSecond(ATime: TDateTime; Delta: Integer): TDateTime;
function IncMSec(ATime: TDateTime; Delta: Integer): TDateTime;
function CutTime(ADate: TDateTime): TDateTime; {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF SUPPORTS_INLINE} { Set time to 00:00:00:00 }
{ String to date conversions }
function GetDateOrder(const DateFormat: string): TDateOrder;
function MonthFromName(const S: string; MaxLen: Byte): Byte;
function StrToDateDef(const S: string; Default: TDateTime): TDateTime;
function StrToDateFmt(const DateFormat, S: string): TDateTime;
function StrToDateFmtDef(const DateFormat, S: string; Default: TDateTime): TDateTime;
//function DefDateFormat(AFourDigitYear: Boolean): string;
//function DefDateMask(BlanksChar: Char; AFourDigitYear: Boolean): string;
function FormatLongDate(Value: TDateTime): string;
function FormatLongDateTime(Value: TDateTime): string;
{ end JvDateUtil }
function BufToBinStr(Buf: Pointer; BufSize: Integer): string;
function BinStrToBuf(Value: string; Buf: Pointer; BufSize: Integer): Integer;
{ begin JvStrUtils }
{ ** Command line routines ** }
function GetCmdLineArg(const Switch: string; ASwitchChars: TSysCharSet): string;
{ ** Numeric string handling routines ** }
function Numb2USA(const S: string): string;
{ Numb2USA converts numeric string S to USA-format. }
function Dec2Hex(N: Longint; A: Byte): string; {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF SUPPORTS_INLINE}
{ Dec2Hex converts the given value to a hexadecimal string representation
with the minimum number of digits (A) specified. }
function Hex2Dec(const S: string): Longint;
{ Hex2Dec converts the given hexadecimal string to the corresponding integer
value. }
function Dec2Numb(N: Int64; A, B: Byte): string;
{ Dec2Numb converts the given value to a string representation with the
base equal to B and with the minimum number of digits (A) specified. }
function Numb2Dec(S: string; B: Byte): Int64;
{ Numb2Dec converts the given B-based numeric string to the corresponding
integer value. }
function IntToBin(Value: Longint; Digits, Spaces: Integer): string;
{ IntToBin converts the given value to a binary string representation
with the minimum number of digits specified. }
function IntToRoman(Value: Longint): string;
{ IntToRoman converts the given value to a roman numeric string
representation. }
function RomanToInt(const S: string): Longint;
{ RomanToInt converts the given string to an integer value. If the string
doesn't contain a valid roman numeric value, the 0 value is returned. }
function FindNotBlankCharPos(const S: string): Integer;
function FindNotBlankCharPosW(const S: WideString): Integer;
function AnsiChangeCase(const S: string): string;
function WideChangeCase(const S: string): string;
function StartsText(const SubStr, S: string): Boolean;
function EndsText(const SubStr, S: string): Boolean;
function DequotedStr(const S: string; QuoteChar: Char = ''''): string;
function AnsiDequotedStr(const S: string; AQuote: Char): string; // follow Delphi 2009's "Ansi" prefix
{end JvStrUtils}
{$IFDEF UNIX}
function GetTempFileName(const Prefix: AnsiString): AnsiString;
{$ENDIF UNIX}
{ begin JvFileUtil }
function FileDateTime(const FileName: string): TDateTime;
function HasAttr(const FileName: string; Attr: Integer): Boolean;
function DeleteFilesEx(const FileMasks: array of string): Boolean;
function NormalDir(const DirName: string): string;
function RemoveBackSlash(const DirName: string): string; // only for Windows/DOS Paths
function ValidFileName(const FileName: string): Boolean;
{$IFDEF MSWINDOWS}
function FileLock(Handle: Integer; Offset, LockSize: Longint): Integer; overload;
function FileLock(Handle: Integer; Offset, LockSize: Int64): Integer; overload;
function FileUnlock(Handle: Integer; Offset, LockSize: Longint): Integer; overload;
function FileUnlock(Handle: Integer; Offset, LockSize: Int64): Integer; overload;
{$ENDIF MSWINDOWS}
function GetWindowsDir: string;
function GetSystemDir: string;
function ShortToLongFileName(const ShortName: string): string;
function LongToShortFileName(const LongName: string): string;
function ShortToLongPath(const ShortName: string): string;
function LongToShortPath(const LongName: string): string;
{$IFDEF MSWINDOWS}
procedure CreateFileLink(const FileName, DisplayName: string; Folder: Integer);
procedure DeleteFileLink(const DisplayName: string; Folder: Integer);
{$ENDIF MSWINDOWS}
{ end JvFileUtil }
// Works like PtInRect but includes all edges in comparision
function PtInRectInclusive(R: TRect; Pt: TPoint): Boolean;
// Works like PtInRect but excludes all edges from comparision
function PtInRectExclusive(R: TRect; Pt: TPoint): Boolean;
function FourDigitYear: Boolean; {$IFDEF SUPPORTS_DEPRECATED} deprecated; {$ENDIF}
function IsFourDigitYear: Boolean;
{ moved from JvJVCLUTils }
//Open an object with the shell (url or something like that)
function OpenObject(const Value: string): Boolean; overload;
function OpenObject(Value: PChar): Boolean; overload;
{$IFDEF MSWINDOWS}
//Raise the last Exception
procedure RaiseLastWin32; overload;
procedure RaiseLastWin32(const Text: string); overload;
//Raise the last Exception with a small comment from your part
{ GetFileVersion returns the most significant 32 bits of a file's binary
version number. Typically, this includes the major and minor version placed
together in one 32-bit Integer. It generally does not include the release
or build numbers. It returns 0 if it failed. }
function GetFileVersion(const AFileName: string): Cardinal;
//Get version of Shell.dll
function GetShellVersion: Cardinal;
// CD functions
procedure OpenCdDrive;
procedure CloseCdDrive;
// returns True if Drive is accessible
function DiskInDrive(Drive: Char): Boolean;
{$ENDIF MSWINDOWS}
//Same as linux function ;)
procedure PError(const Text: string);
// execute a program without waiting
procedure Exec(const FileName, Parameters, Directory: string);
// execute a program and wait for it to finish
function ExecuteAndWait(CommandLine: string; const WorkingDirectory: string; Visibility: Integer = SW_SHOW): Integer;
function MakeYear4Digit(Year, Pivot: Integer): Integer;
//function StrIsInteger(const S: string): Boolean;
function StrIsFloatMoney(const Ps: string): Boolean;
function StrIsDateTime(const Ps: string): Boolean;
function PreformatDateString(Ps: string): string;
function BooleanToInteger(const B: Boolean): Integer;
function StringToBoolean(const Ps: string): Boolean;
function SafeStrToDateTime(const Ps: string): TDateTime;
function SafeStrToDate(const Ps: string): TDateTime;
function SafeStrToTime(const Ps: string): TDateTime;
function StrDelete(const psSub, psMain: string): string;
{ returns the fractional value of pcValue}
function TimeOnly(pcValue: TDateTime): TTime;
{ returns the integral value of pcValue }
function DateOnly(pcValue: TDateTime): TDate;
type
TdtKind = (dtkDateOnly, dtkTimeOnly, dtkDateTime);
const
{ TDateTime value used to signify Null value}
NullEquivalentDate: TDateTime = 0.0;
from db.pas
FILE_PATH = 'E:\maxbox\maxbox3\examples\271_closures_study.txt';
var
LoginDialogProc: function (const ADatabaseName: string; var AUserName, APassword: string): Boolean;
LoginDialogExProc: function (const ADatabaseName: string; var AUserName, APassword: string; NameReadOnly: Boolean): Boolean;
RemoteLoginDialogProc: function (var AUserName, APassword: string): Boolean;
ScreenCursorProc: procedure (const CurIndex : integer);
PasswordDialog: function (const ASession: IDBSession): Boolean;
DBScreen: IDBScreen;
DBApplication: IDBApplication;
{ Global Functions }
function ExtractFieldName(const Fields: string; var Pos: Integer): string; overload; deprecated;
function ExtractFieldName(const Fields: WideString; var Pos: Integer): WideString; overload;
procedure RegisterFields(const FieldClasses: array of TFieldClass);
procedure DatabaseError(const Message: WideString; Component: TComponent = nil);
procedure DatabaseErrorFmt(const Message: WIdeString; const Args: array of const;
Component: TComponent = nil);
procedure DisposeMem(var Buffer; Size: Integer);
function BuffersEqual(Buf1, Buf2: Pointer; Size: Integer): Boolean;
{ moved to FmtBcd.pas
function BCDToCurr(const BCD: TBcd; var Curr: Currency): Boolean;
function CurrToBCD(Curr: Currency; var BCD: TBcd; Precision: Integer = 32;
Decimals: Integer = 4): Boolean; }
function GetFieldProperty(DataSet: TDataSet; Control: TComponent;
const FieldName: WideString): TField;
function VarTypeToDataType(VarType: Integer): TFieldType;
implementation
//SQLQuery = 'select count(*) from Auftrag.DB';
//SQLQuery = 'select * from maschine';
//INSERT INTO mytable (id,label) VALUES (%s,"%s");',
//SQLQueryExec = 'UPDATE ID2013 SET Stationen = 13';
//SQLQuery = 'select * from ID2013';
//Miete
//SQLQueryExec = 'UPDATE ID2014.DB SET MieteAblauf = ''31.12.2015'' WHERE Kunde=''GRAEFEN''';
//SQLQuery = 'select * from IDknabe.DB';
//Integer = LONG, Boolean = LOGICAL smallint=SHORT
// SQLQueryExec = 'ALTER TABLE PrParams ADD AngTextbreite Integer';
// SQLQueryExec = 'ALTER TABLE PrParams ADD AbTextbreite Integer';
// SQLQueryExec = 'ALTER TABLE PrParams ADD AufTextbreite Integer';
// SQLQueryExec = 'ALTER TABLE PrParams ADD ReTextbreite Integer';
// SQLQueryExec = 'ALTER TABLE PrParams ADD LSTextbreite Integer';
//SQLQueryExec = 'ALTER TABLE PrParams ADD AufPrintBeschreibung2 Boolean';
//SQLQueryExec = 'ALTER TABLE PrParams ADD AufPrintBeschreibung2Name CHAR(50)';
//SQLQueryExec = 'ALTER TABLE PrParams DROP AufPrintBeschreibung2';
//SQLQueryExec = 'ALTER TABLE PrParams ADD AufPrintBeschreibung2View CHAR(20)';
//SQLQueryExec = 'ALTER TABLE Vorgaben ADD Nutzen smallint';
//vorgaben bf 209 , k 205!
//SQLQueryExec = 'ALTER TABLE Vorgaben ADD CadDateiIstProgNr boolean';
//SQLQueryExec = 'ALTER TABLE Vorgaben ADD HilfstypNrPerfa char(5)';
//SQLQueryExec = 'ALTER TABLE Vorgaben ADD HilfstypNrResy char(5)';
//SQLQuery = 'select * from PRParams.DB';
//SQLQuery = 'select * from ID.DB';
//SQLQuery = 'select * from Vorgaben.DB';
// SQLQueryExec = 'ALTER TABLE Kunde ADD ABErforderlich3 Boolean';
// SQLQueryExec = 'ALTER TABLE Kunde DROP Beschreibung3 BLOB';
//Session 17.2. add and alter
// SQLQueryExec = 'ALTER TABLE Kunde ADD ABErforderlich Boolean';
//SQLQueryExec = 'ALTER TABLE Kunde ADD REPrintAufschlag Boolean';
//SQLQueryExec = 'ALTER TABLE PrParams ADD AufPrintBeschreibung2View CHAR(20)';
// SQLQueryExec = 'ALTER TABLE Auftrag ADD Beschreibung2 BLOB(1,80)';
//SQLQueryExec = 'ALTER TABLE Auftrag ADD Beschreibung2 Memo BLOB';
//SQLQueryExec = 'ALTER TABLE Auftrag ADD Beschreibung2 BLOB SUB_TYPE 1';
//Session 18.2. BLOB Memory install
// SQLQueryExec = 'ALTER TABLE Kunde ADD Beschreibung3 BLOB';
// SQLQueryExec = 'ALTER TABLE Einheit ADD Beschmoney4 MONEY';
// SQLQueryExec = 'ALTER TABLE Einheit ADD Beschmoney4 BLOB';
SQLQueryExec = '';
//SQLQuery = 'select count(*) from Kunde.DB';
SQLQuery = 'select count(*) from Einheit.DB';
//SQLQueryExec = 'UPDATE Maschine SET Einheit = ''min22'' WHERE Nr=''505''';
//SQLQueryExec = 'DELETE FROM maschine WHERE Nr=''651''';
//SQLQueryExec = 'INSERT INTO Maschine (Nr,DL,Einheit,EK) '+
// 'VALUES (''652'',''maxmachine2'',''min'',''120.44'')';
//SQLQuery = 'select * from maschine';
{'Select AuftragsNr, KundenNr, Suchbegriff, Status, Termin, Menge, VKTotal, ProgNr '+
'from Auftrag, AufAtb, Kunde where '+
'Auftrag.AuftragsNr = AufAtb.AuftragsNr AND AufAtb.KundenNr = Kunde.KundenNr '+
'AND Status = '+ASTATUS+' AND AuftragsNr > '+ABAUFTRAG+' ORDER BY KundenNr, Termin, Menge';}
{const SQLQuery = 'Select AuftragsNr, Termin, ReNr, KundenNr, ProgNr, Text1, Text2 FROM Auftrag, Aufpos where '+
'Auftrag.AuftragsNr = Aufpos.AuftragsNr AND AuftragsNr > 42543 '+
'ORDER BY Termin,AuftragsNr';}
///const SQLQuery = 'Select AuftragsNr, ReNr, Text1, Text2 FROM Auftrag, Aufpos where '+
// 'Auftrag.AuftragsNr = Aufpos.AuftragsNr AND AuftragsNr > 42543';
//const SQLQuery = 'Select count(*) from Auftrag';
//const SQLQuery = 'Select AuftragsNr, ReNr, Text1, Text2 FROM Auftrag, Aufpos where '+
// 'Auftrag.AuftragsNr = Aufpos.AuftragsNr AND AuftragsNr > 212000';
//const SQLQuery = 'select * from customer where company like "%SCUBA%"''';
//const SQLQuery = 'Select Fertig, AuftragsNr, LeistungsNr from ZeitBTmp';
//const SQLQuery = 'Select Fertig, BeginnDatum, AuftragsNr, LeistungsNr from ZeitBtmp where AuftragsNr > 200000';
(*with SqlSearchAB do begin
Close;
Sql.Clear;
Sql.Add('Select AbNr, ATBNr, Produkt, Menge, Einheit, EP, Vk, Rabatt, Rabattbetrag, VkTotal, Termin from AbATB');
Sql.Add(format('where AuftragsNr=%d',[aAuftragsNr]));
Open;
end;*)
var
dbMain: TDatabase; //@global
TUTIL50.zip
As you can see, the code for the SQLIndexTbl is quite a bit longer than the IndexTbl code. But most of that is due to having to specially parse the field string to convert it to the appropriate SQL syntax. In actuality, the parse step happens really fast, so you don't get too much of a degradation in performance.
For quick no-brainer secondary index indexing, I use the SQLIndexTbl. Since it's just strings that I have to input, it's a bit easier. However, if I want to have finer control over the indexing, I almost invariably use the IndexTbl procedure.
DevX Pro