Příklady PASCAL
Z K.A.P.
Verze z 15. 2. 2015, 14:55, kterou vytvořil Grepl (diskuse | příspěvky) (→Příklad 12 - Práce s požadavky (objednávkami zákazníků) za pomocí TKAPOrder)
Příklady programů ve skriptovacím programovacím jazyku v jazyku Pascal.
Obsah
- 1 Příklad 1 - práce s proměnnými uloženými do databáze
- 2 Příklad 2 - spuštění sestavy z generátoru sestav
- 3 Příklad 3 - odeslání mailu s přílohou pomocí SMTP
- 4 Příklad 4 - odeslání souboru pomocí MaximObjServeru
- 5 Příklad 5 - použití funkcí objektu TMOSCommunicator pro komunikaci s MaximObjServerem
- 6 Příklad 6 - práce s TKAPBtrTable ve formuláři
- 7 Příklad 7 - použití paměťové tabulky TKAPMemTable
- 8 Příklad 8 - použití externího datového zdroje pomocí TKAPADOTable
- 9 Příklad 9 - Spuštění funkce z hlavního menu aplikace
- 10 Příklad 10 - Spuštění funkce z hlavního menu s obslužnou procedurou menu
- 11 Příklad 11 - Použití objektu TKAPIndPrice
- 12 Příklad 12 - Práce s XML za pomocí Msxml2.DOMDocument
- 13 Příklad 13 - Práce s požadavky (objednávkami zákazníků) za pomocí TKAPOrder
Příklad 1 - práce s proměnnými uloženými do databáze
var i: integer;
s: String;
begin
s:=IniReadString('ScriptTest', 1, True, _AktualniSklad_, '5');
ShowMessage(Settings.Values['INI.FirmaJmeno']+chr(13)+Settings.Values['USER.JmenoUziv']+chr(13)+_KonfigDir_);
LogWrite('Direktivy:'+_Direktivy_);
if s <> '' then
i := StrToInt(s)+1
else
i := -10;
if not IniWriteInteger('ScriptTest', 1, True, _AktualniSklad_, i) then
ShowMessage('V IniWriteInteger se vyskytla chyba');
end.
Příklad 2 - spuštění sestavy z generátoru sestav
var
s: String;
d1, d2: TDateTime;
DD, MM, YY : word;
begin
DecodeDate(Date, YY, MM, DD);
if MM=1 then begin // Zjisteni predchoziho mesice
MM := 12;
YY := YY - 1;
end else
MM := MM - 1;
D1 := EncodeDate(YY, MM, 1);
D2 := EncodeDate(YY, MM, DaysInMonth(YY, MM));
S := GSRunReport(6, 1, 'KFG_Datum1='+StrDate(D1)+chr(13)+ 'KFG_Datum='+StrDate(D2)+chr(13)+ 'INI_Jmeno=Pokusný sklad');
//S := GSRunReportV(6, 1, ['KFG_Datum1', 'KFG_Datum', 'INI_Jmeno'],[StrDate(D1), StrDate(D2), 'Pokusný sklad']);
if EnumStr(S, 0, #13)='OK' then
ShowMessage('Výpočet OK, výsledek sestavy je v '+EnumStr(S, 1, #13))
else
ShowMessage(S)
end.
Příklad 3 - odeslání mailu s přílohou pomocí SMTP
var
s: String;
begin
//From, SendTo, FileAttach, Subject, SMTPServer, SMTPSenderName, SMTPPassword, BodyString, ErrMessage
if SendMailBySMTP('odesilatel@posta.cz', 'prijemce@mail.com', 'UZIV\SESTAVA1.SLK'#9'UZIV\SESTAVA2.SES'#13'UZIV\vystup.pdf', 'Test scriptu', 'smtp.posta.cz', 'SMTPjmeno', 'SMTPheslo', 'Testovaci email.'#13'Konec', s) then
ShowMessage('OK '+ s)
else
ShowMessage('CHYBA '+ s);
end.
Příklad 4 - odeslání souboru pomocí MaximObjServeru
var MOSCommunicator: TMOSCommunicator;
begin
MOSCommunicator := TMOSCommunicator.Create('MOS.bin', '', '', '', 0);
if MOSCommunicator.SendFile('C:\DIR\DATA1.xml', 'DATA1.XML', '', '', '', True) then
LogWrite('Prenos OK')
else
LogWrite(MOSCommunicator.ErrMessage);
MOSCommunicator.Free;
end.
Příklad 5 - použití funkcí objektu TMOSCommunicator pro komunikaci s MaximObjServerem
var MOSCommunicator: TMOSCommunicator;
Info: String;
Velikost: Extended;
Cas: TDateTime;
begin
MOSCommunicator := TMOSCommunicator.Create('', '192.168.17.1', 'MOSuser', 'MOSpswd', 1);
try
if MOSCommunicator.Connect then begin // pokud se připojím, pak se vše realizuje
// v rámci jednoho připojení
// ShowMessage('Pripojeno');
if MOSCommunicator.Connected then begin // test navic
if MOSCommunicator.SendSMS('111222333','Pokus o poslani SMS') then
ShowMessage('SMS odeslana.')
else
ShowMessage('Chyba pri odesilani SMS:'#13+MOSCommunicator.ErrMessage);
if MOSCommunicator.SendFile('C:\DIR\DATA1.xml', 'DATA1.XML', '', '', '', False) then
begin
ShowMessage('Prenos OK');
if MOSCommunicator.GetFileInfo('Sklad6DOC', 'Stavy.xml', Info, Velikost, Cas) then begin
ShowMessage('GetFileInfo:'#13 + Info+ #13 + FloatToStr(Velikost) + #13 + DateTimeToStr(Cas));
if not MOSCommunicator.GetFile('C:\DIR\Stavy2.XML', 'Podslozka\Stavy.xml', 'Sklad6DOC') then
ShowMessage('GetFile:'#13+MOSCommunicator.ErrMessage);
end else
ShowMessage('GetFileInfo:'#13+MOSCommunicator.ErrMessage);
end else
ShowMessage('SendFile'#13+MOSCommunicator.ErrMessage);
MOSCommunicator.Disconnect;
end else
ShowMessage(MOSCommunicator.ErrMessage);
end else
ShowMessage(MOSCommunicator.ErrMessage);
finally
MOSCommunicator.Free;
end;
end.
Příklad 6 - práce s TKAPBtrTable ve formuláři
var
t: TKAPBtrTable;
f: TForm;
DBGrid: TDBGrid;
ds: TDataSource;
begin
ds := nil;
t := TKAPBtrTable.Create;
try // try-finally část není nutná, ale správně se takto řeší problémové situace
t.TableName := 'CISELNIK.btr'; // jméno tabulky bez cesty
t.IndexFieldNames := 'TypCis;Klic1'; // index s těmito poli musí v tabulce existovat
if MsgDlg('Přejete si použít filtr ?', 'Testovací skript', mtConfirmation,
msgboxOK + msgboxCancel, 'mbOK=Použít filtr') = mrOK then begin
t.Filter := '(TypCis=161)AND(PosUp("T",Klic1)=1)';
t.Filtered := true;
end;
t.Open;
f := TForm.Create(Application);
try
f.Caption := 'Zobrazení ' + t.TableName;
f.Position := poDefault;
DBGrid:= TDBGrid.Create(f); // parametr určuje vlastníka prvku DBGrid
DBGrid.Parent := f; // Parent určuje, na kterém formuláři se má DBGrid zobrazit
DBGrid.Align := alClient; // alClient znamená vyplnit celý formulář
ds:= TDataSource.Create(f); // TDataSource propojuje tabulku s vizuálními prvky pro editaci (DBGrid)
DBGrid.DataSource := ds;
ds.DataSet := t;
f.ShowModal; // hlavní okno je třeba vždy otevírat pomocí ShowModal
finally
F.Free; // objekty, kterým byl určen vlastník (DBGrid) se ruší automaticky
end; // při rušení vlastníka (při F.Free se ruší DBGrid i ds)
finally
t.Free; // vytvořené objekty je třeba zrušit
end;
end.
Příklad 7 - použití paměťové tabulky TKAPMemTable
var t: TKAPMemTable;
f:TForm;
DBGr: TDBGrid;
ds: TDataSource;
MinA, x: Integer;
begin
t := TKAPMemTable.Create;
try
t.FieldDefs.Add('A',ftInteger,0, false);
t.FieldDefs.Add('B',ftString,30, false);
t.FieldDefs.Add('C',ftfloat,0, false);
t.FieldDefs.Add('D',ftDate,0, false);
t.FieldDefs.Add('E',ftTime,0, false);
t.CreateTable(nil);
// t.IndexFieldNames := 'A;B';
t.AddIndex('i1', 'A;B',[ixCaseInsensitive]); // nesmi byt prazdna mnozina
t.IndexName := 'i1';
t.Open;
t.Append;
t.FieldByName('A').AsInteger := 5555;
t.FieldByName('B').AsString := 'TEST';
t.FieldByName('C').AsFloat := 10.5;
t.Post;
t.Append;
t.FieldByName('A').AsInteger := 4444;
t.FieldByName('D').AsDateTime := Date+1;
t.Post;
t.Append;
t.FieldByName('A').AsInteger := 3333;
t.Post;
t.Append;
t.FieldByName('A').AsInteger := 8888;
t.Post;
t.First;
MinA := t.FieldByName('A').AsInteger;
while not t.EOF do begin
if t.FieldByName('A').AsInteger < MinA then MinA := t.FieldByName('A').AsInteger;
t.Next;
end;
ShowMessage('Min: '+IntToStr(MinA));
f := TForm.Create(Application);
try
f.Caption := 'Zobrazení MemTable';
f.Width := 1024;
f.Height := 768;
DBGr:= TDBGrid.Create(f);
DBGr.Parent := f;
DBGr.Align := alClient;
ds:= TDataSource.Create(f);
DBGr.DataSource :=ds;
ds.DataSet := t;
f.ShowModal;
finally
f.free;
end
// x := t.RecordCount;
finally
t.Free;
end
end.
Příklad 8 - použití externího datového zdroje pomocí TKAPADOTable
var
t: TKAPADOTable;
f:TForm;
DBGr: TDBGrid;
ds: TDataSource;
spl1: TSplitter;
lb: TListBox;
i : integer;
// Fld : TField;
begin
f := nil;
DBGr := nil;
ds := nil;
t := TKAPADOTable.Create;
t.ConnectionString:= 'Provider=Microsoft.Jet.OLEDB.4.0;Data Source=C:\Slozka\TestData.xls;Extended Properties=Excel 8.0';
try
try
t.TableName := 'Tabulka'; // data v tabulce MS Excel označte pomocí funkce Definovat název
t.Open;
f := TForm.Create(nil);
f.Caption := 'Zobrazení dat z Excelu';
f.Width := 1024;
f.Height := 768;
DBGr:= TDBGrid.Create(f);
DBGr.Parent := f;
DBGr.Align := alLeft;
DBGr.Width := 800;
DBGr.ReadOnly := true;
spl1 := TSplitter.Create(f);
spl1.Parent := f;
spl1.Align := alLeft;
spl1.Width := 4;
spl1.Left := 802;
lb := TListBox.Create(f);
lb.Parent := f;
lb.Left := 1000;
lb.Top := 300;
lb.Align := alClient;
ds:= TDataSource.Create(f);
DBGr.DataSource := ds;
ds.DataSet := t;
DBGr.Options := dgAlwaysShowSelection + dgCancelOnExit + dgColLines + dgColumnResize + dgConfirmDelete + dgIndicator + dgRowLines + dgRowSelect + dgTitles;
for i := 0 to DBGr.Columns.Count - 1 do begin // sloupce gridu se připraví po spojení gridu s otevřeným datasetem
lb.Items.Add(DBGr.Columns[i].FieldName);
DBGr.Columns[i].Width := 80;
end;
// for i := 0 to t.FieldCount - 1 do begin // jiný způsob jak projít pole tabulky (nezávislý na gridu)
// lb.Items.Add(t.Fields[i].FieldName); // takto to nefunguje
// Fld := t.Fields[i]; // Field je nutné nejdříve přiřadit do proměnné typu TField
// lb.Items.Add(Fld.FieldName);
// Fld.DisplayWidth := 12;
// end;
f.ShowModal;
except
ShowMessage(ExceptionMessage);
end;
Finally
t.Free;
if ds <> nil then
ds.Free;
if F <> nil then
F.Free;
end;
end.
procedure DoOnWaitKey(WaitForKeyInfo: TKAPAppControlWaitForKeyInfo);
begin
if PosUp('OBDOB', App.ActiveWindowCaption) > 0 then begin
App.PressFnKeys('F2');
end;
end;
// hlavní část
begin
App.OnWaitForKey := @DoOnWaitKey;
//App.RunMenu(KodMenu1, KodMenu2, PristPravo: byte; Keys: string);
//Kód menu lze zjistit v rámci Systémové menu/Menu
App.RunMenu(1, 15, 9, '"181212" Tab "201212"');
// v rámci spuštění položky menu s kódem KodMenu1 a KodMenu2 lze klávesy "namačkat" dopředu;
// pokud program vyčerpá klávesy ze zásobníku a obslužná procedura nestiskne další klávesu, pak program funkci automaticky ukončuje pomocí ESC
end.
procedure DoOnMenu(MenuInfo: TKAPAppControlMenuInfo);
begin
if MenuInfo <> nil then
if Trim(App.ActiveWindowCaption) = 'Kontrola' then begin
if MenuInfo.MenuItemsCount > 1 then
MenuInfo.SelectedMenuItem := 2;
end else
if PosUp('Kontrola datumu spotřeby', App.ActiveWindowCaption) >= 1 then begin
MenuInfo.SelectedMenuItem := 3;
App.PressKeys('"50" F2');
end;
end;
// hlavní část
begin
App.OnMenu := @DoOnMenu;
App.RunMenu(3, 4, 9, '');
end.
Příklad 11 - Použití objektu TKAPIndPrice
var
IC: TKAPIndPrice;
Cena, CenaSDPH: Double;
UrovenDPH: byte;
KodKarty : string;
begin
IC := TKAPIndPrice.Create;
try
KodKarty := '1020199';
Cena := IC.KartaCena(KodKarty, 1, false); // první cenové pásmo z karty - cena bez DPH
UrovenDPH := IC.KartaUrovenDPH(KodKarty); // pořadové číslo sazby DPH 0, 1, 2...
// použije se individuální cena MOJEIC nebo aternativní individuální cena IND*
// Cena musí být naplněna již před voláním IC.IndividualniCena
if IC.IndividualniCena('MOJEIC', 'IND*', KodKarty, 1, 0, Date, 1, Cena, CenaSDPH) then
ShowMessage('Výsledná cena: '+FormatFloat('#.00', Cena)+' cena s DPH: '+FormatFloat('#.00', CenaSDPH))
else begin
CenaSDPH := IC.CenaSDPH(Cena, UrovenDPH);
ShowMessage('Individuální cena nebyla pro dané zboží vyhodnocena'#13+
'Základní cena: '+FormatFloat('#.00', Cena)+' cena s DPH: '+FormatFloat('#.00', CenaSDPH));
end;
finally
IC.Free;
end;
end.
Příklad 12 - Práce s XML za pomocí Msxml2.DOMDocument
var
XMLDoc: Variant;
ZaznamList, FieldNode : Variant;
InfoStr: string;
I, Cnt: integer;
begin
// XMLDoc:=CreateOLEObject('Msxml2.DOMDocument.6.0'); -- potřebuje novější verzi MSXML; umožňuje ale např. práci s XSD šablonami
XMLDoc :=CreateOLEObject('Msxml2.DOMDocument');
try
XMLDoc.async:= False;
XMLDoc.resolveExternals:= False;
XMLDoc.Load('Respons.XML');
// XMLDoc.LoadXML(textXML) -- umožňuje načíst XML ve formě textu
{
<?xml version="1.0" encoding="UTF-8"?>
<soapenv:Envelope xmlns:soapenv="http://schemas.xmlsoap.org/soap/envelope/">
<soapenv:Body>
<StatusNespolehlivyPlatceResponse xmlns="http://adis.mfcr.cz/rozhraniCRPDPH/">
<status odpovedGenerovana="2013-03-31" statusCode="0" statusText="OK"/>
<statusPlatceDPH dic="CZ6301050074" nespolehlivyPlatce="NENALEZEN"/>
<statusPlatceDPH dic="CZ27495132" nespolehlivyPlatce="NENALEZEN"/>
</StatusNespolehlivyPlatceResponse>
</soapenv:Body>
</soapenv:Envelope>
}
if XMLDoc.parseError.errorCode = 0 then begin
ZaznamList:= XMLDoc.getElementsByTagName('soapenv:Body');
if ZaznamList.Length > 0 then begin
ZaznamList:= ZaznamList.item(0).childNodes; // zanoří se do dané větve XML
if ZaznamList.Length > 0 then begin
FieldNode := ZaznamList.item(0);
if FieldNode.NodeName = 'StatusNespolehlivyPlatceResponse' then begin
ZaznamList:= FieldNode.childNodes;
Cnt := 0;
InfoStr := ' ';
for I := 0 to ZaznamList.Length - 1 do begin
FieldNode := ZaznamList.item(I);
if FieldNode.NodeName = 'statusPlatceDPH' then
inc(Cnt)
else
if FieldNode.NodeName = 'status' then
InfoStr := Format('Ze dne %s', [FieldNode.getAttribute('odpovedGenerovana')])
end;
ShowMessage(Format('Počet záznamů "statusPlatceDPH": %d'#13'%s', [Cnt, InfoStr]));
end;
end;
end;
end else
ShowMessage(Format('Chyba při čtení XML: %d %s', [XMLDoc.parseError.errorCode, xmlDoc.parseError.reason]));
finally
XMLDoc := nil;
end;
end.
Příklad 13 - Práce s požadavky (objednávkami zákazníků) za pomocí TKAPOrder
var
Order: TKAPOrder;
OrderItem: TKAPOrderItem;
OK: Boolean;
begin
Order := TKAPOrder.Create(true);
try
if Order.SetCustomer('12675962') then begin {odběratel musí být v adresáři odběratelů}
Order.Pozadovano := Date+2;
Order.Radek1:= 'Testovací objednávka';
Order.Uhrada:= 1; {hotově}
Order.MemoA.Add('Poznámka nahoře');
Order.MemoB.Add('Poznámka dole');
OK := Order.AddOrderItem('20092', 12, 0, true, 0, 'test'); {zboží s kódem 20092 musí existovat v seznamu karet}
if OK then
OK := Order.AddOrderItem('54005', 24, 0, true, 0, ' ');
if OK then begin
OrderItem := Order.Items[0]; {zpřístupní první položku objednávky}
OrderItem.Quantity := 6; {a u této položky změní počet MJ na 6}
Order.DeleteItem(1); {odstraní druhou položku objednávky - 54005}
OK := Order.AddOrderItem('50056', 1, 0, true, 0, 'VL');
end;
if OK then
OK := Order.SaveOrder;
if OK then
if length(Order.LastError) = 0 then
ShowMessage(Format('Nová objednávka uložena pod číslem %d', [Order.CisloObjednavky]))
else
ShowMessage(Order.LastError)
else
ShowMessage(Order.LastError)
end else
ShowMessage('Chyba při zpracování objednávky'#13+Order.LastError);
finally
Order.Free;
end;
end.
