Versions Compared

Version Old Version 21 New Version Current
Changes made by

Mika Koistinen

Kaj Bjork

Saved on

Key

  • This line was added.
  • This line was removed.
  • Formatting was changed.


Info

https://stash.skj.fi/projects/SKRIP

...

Function StrToF(s: string): Double;

    • muuntaa merkkijono liukuluvuksi. poistaa välilyönnit ja huolehtii piste/pilkku muunnoksesta.
  • procedure CSVToStringList(Lahde: String; Kohde: TStringList; Erotin: Char; RiisuLainausMerkit: Boolean);

    • purkaa csv muodossa olevan merkkijono StringListaksi esim.
      lista := TStringList.create;

      Panel

      s := '1;"ohje esimerkki";12,2';

      CSVToStringList(s,lista,';',true);
      for i:= 0 to Lista.count -1 do
        ShowMessage(Lista.items[i]);


Katso myös CSV_Tuonti.htm esimerkki.

Numerot

  • Arc
  • Tan
  • Dec
  • Inc
    • Lisää yhden muuttujaan, esim Inc(count)
  • Pyorista(Luku; tarkkuus)
    • Pyöristää luvun annettuun tarkkuuteen, esim -2 -> 2 desimaaliin, 2 = lähimpään 100:n
  • SimpleRoundTo
    • Sama kuin pyöristä, mutta johtuen d7 system kirjaston bugista, toimii väärin jossain tilanteissa. Pyorista korjaa sen. D2007 versioon korjautunut.
  • RoundTo

Päiväys

  • function Date:TDateTime;
    • palauttaa nykyisen päiväyksen DateTime tyyppinä
  • function DateTimeToStr(DateTime: TDateTIme):String;
    • muuntaa annetun päiväyksen / kellonajan merkkijonoksi windowin asetusten mukaan.
  • function DateToStr (Date: TDateTime): String;
    • muuntaa annetun päiväyksen merkkijonoksi windowsin asetusten mukaan.
  • function DayOfWeek (date: TdateTime):Integer;
    • palauttaa viikonpäivän numerovälillä su (1) .. la (7)
  • function DayOfTheWeek (date: TdateTime):Integer;
    • palauttaa viikonpäivän numerovälillä ma (1) .. su (7). ANSI -standardin mukainen.
  • function SqlDateToDate(dateString: String): Tdatetime;
    • Muuttaa yyyy-mm-dd muotoisen päiväysmerkkijonon sisäiseksi Tdatetime -tyypiksi.
  • DecodeDate
  • DecodeTime
  • EncodeDate
  • EncodeTime
  • IsLeapYear
  • StrToDate
  • StrToDateTime
  • Functon Now: TdateTime
    • palauttaa nykyhetken
  • function FormatDateTime(format: string; DateTime: Tdatetime):String;
    • Muotoilee ajan ja päivän annetulla formaatilla kts.
  • StrToTime
  • Time
  • TimeToStr

Bonuslaskenta

  • function AlustaBonus(Tietokanta): Bonusluokka;
    • lataa bonusasetukset. Kutsu vain kerran ja jokaista AlustaBonus rutiinin kutsua kohden pitää kutsua vapautabonus.
  • procedure VapautaBonus(Bonusluokka);
    • vapauttaa aiemmin AlustaBonus funktiolla luodun bonusmuuttuja.
  • function BonusPros(kertyma:Double): Double;
    • palauttaa bonusprosentin johon ostokertymä oikeuttaa

Tietokanta

Titan -komponentin liityntä tauluun luodaan seuraavasti

Code Block
languagedelphi
Tuotetaulu := TTbTable.create(nil);
tuotetaulu.tablename := 'tuote';
tuotetaulu.databasename := 'testikanta';
tuotetaulu.open;
... ja lopuksi
tuotetaulu.free;
  • function TTbTable.TryEdit (ms_viive: integer);

    • tTbTable-luokan menetelmä. Yrittää saada muokkausoikeuden taulun nykyiseen tietueeseen ja yritetään korkeintaan ms_viiveen ajan. Aika on millisekunteina. Palauttaa false jos epäonnistui, esim.

      Code Block
      languagedelphi
      if not tuote.tryedit(2000) then
  showmessage('Tuotetta ei voi muokata');
  • function TTbTable.TryPost (ms_viive: integer);

    • tTbTable-luokan menetelmä. Yrittää saada muokkausoikeuden taulun nykyiseen tietueeseen ja yritetään korkeintaan ms_viiveen ajan. Aika on millisekunteina. Palauttaa false jos epäonnistui, esim.

      Code Block
      languagedelphi
      if varsaldo.tryEdit(2000) then
begin
  varsaldo.fieldbyname('saldo').asfloat := 0;
  varsaldo.fieldbyname('muutosklo').asdatetime := now;
  if not varsaldo.trypost(2000) then
  begin
    logentry('Varsaldoa ei voi tallentaa');
    varsaldo.cancel;
  end;
end
else
  showmessage('Saldoa ei voi muokata');

Pervasive sql

Koska pervasiven PDAC komponenttikirjastoista ei ole saatavilla lähdekoodeja, siitä emme ole voineet tuottaa titan rajanpinnan kaltaista liittymää. Sql rajapinta on tehty omilla rutiineilla jotka ovat

  • function LuoSql(TietokantaAlias, sql, tapa) - luo kyselyn ja palauttaa sen muuttujan (jatkossa alla kysely). Voidaan myös lisätä suoraan sql parametriksi esim. q := luosql(dbname,'select count ( * ) as c from from tuote'); joka tekee luonnin lisäksi sql lauseen asettamisen. Vapaaehtoinen 3. parametri tapa voidaan myös antaa. Se voi olla välillä 1-3, 1= avaa kyselyn, 2 = ajaa kysely (update, insert, delete tms), 3= ajaa kyselyn ja vapauttaa sql muutujan. Kun tapa=3, paluu arvona on vaikutettujen rivien määrä.
  • procedure VapautaSql(Kysely) - vapauttaa LuoSql:llä luodun kysely
  • procedure Asetasq(Kysely, SqlLause) - asettaa kyselylle sqllauseen
  • procedure Avaasql(kysely) - avaa sql lauseen esim. raportointia tai aineiston muuta läpikahlausta varten
  • procedure AjaSql(kysely) - ajaa sql lauseen esim. update, insert tai delete.
  • procedure SuljeSql(kysely) - sulkee sql kyselyn
  • function eofSql(kysely) - palautaa True jos kysely on loppu
  • function SqlFirst(kysely) - palaa ensimmäiseen tietueeseen
  • function Sqlnext(kysely) - siirtyy seuraavaan tietueeseen
  • function SqlPrev(kysely) - siirtyy edelliseen tietueeseen
  • function SqlLast(kysely) - siirtyy viimeiseen tietueeseen
  • function Sqlfbi(kysely,kentta) - palauttaa avatusta kyselystä kentän integerinä
  • function Sqlfbb(kysely,kentta) - palauttaa avatusta kyselystä kentän Booleanin
  • function Sqlfbs(kysely,kentta) - palauttaa avatusta kyselystä kentän stringinä
  • function Sqlfbd(kysely,kentta) - palauttaa avatusta kyselystä kentän DateTimeä

Huom! Kysellessä memokenttiä (tuotetxt.teksti, astxt.teksti tms) joiden sisältö on yli 1024 merkkiä, tulee virhe.
Sen voi kiertää ainakin jossain määrin muuttamalla kyselyn "select tuotenro, teksti from tuotetxt" muotoon "select tuotenro, convert(teksti,sql_varchar) as teksti from tuotetxt".
Toinen vaihtoehto on käyttää taulukomponenttia.

Code Block
languagedelphi
kysely := LuoSql('testikanta');
asetasql(kysely,'select tuote,sum(summa) as myynti from tuotemyy where tuotelaji in (0,2) and pvm>''2011'' ');
avaasql(kysely);
while not eofsql(kysely) do
begin
  showmessage(sqlfbs(kysely,'tuote')+' '+formatfloat('#0.00',sqlfbf(kysely,'myynti')));
  sqlnext(kysely);
end;
suljesql(kysely);
vapautasql(kysely);

kysely1 := CreateSql('testikanta','select count(*) as maara from tuote where ryhma = :r');
preparesql(kysely1);
for i := 1 to 10 do
begin
  sqlSetParam(kysely1,'r',i);
  opensql(kysely1);
  showmessage('Tuoteryhmässä '+inttostr(i)+' on tuotteita '+inttostr(sqlfbi(kysely1,'maara')));
  closesql(kysely1);
end;
unprepareSql(kysely1);
vapautasql(kysely1);

Excel liityntä

Excel yhteys perustaa AdoDb:n. Esimerkki avauksesta, tässä excel avataan vain luku tilaan. Lisäksi kerromme että headereita ei ole (HDR=NO) jolloin kentät ovat f1, f2 jne sekä excel ei yritä päätellä datatyyppejä (IMEX=1). Jälkimmäinen on tarpeen jos siellä on tyhjiä tai sekalaisia arvoja samassa sarakkeessa. 

...

languagedelphi

...

Eroja normaaliin pascal syntaksiin

Eroja on, tässä muutama maininta.
Muuttujat ovat pääsääntöisesti aina variantteja. 
Case lause on erilainen , lauseessa ei vaadi että casen arvot ovat vakiota. Ehto totetuu kun funktio paluu arvo täsmää verrattavaan

Code Block
languagedelphi
sanat := 'SIKA;PORSAS;LEHMA;KISSA'; 
s := 'elainLehma';           
case lowercase(copy(s,5)) of        
  lowercase(extractWord(1,sanat,';')) : showmessage('RÖH');
  lowercase(extractWord(2,sanat,';')) : showmessage('röh');
  lowercase(extractWord(3,sanat,';')) : showmessage('ammuu');
  lowercase(extractWord(4,sanat,';')) : showmessage('miau');
end;


Numerot

  • Arc
  • Tan
  • Dec
  • Inc
    • Lisää yhden muuttujaan, esim Inc(count)
  • Pyorista(Luku; tarkkuus)
    • Pyöristää luvun annettuun tarkkuuteen, esim -2 -> 2 desimaaliin, 2 = lähimpään 100:n
  • SimpleRoundTo
    • Sama kuin pyöristä, mutta johtuen d7 system kirjaston bugista, toimii väärin jossain tilanteissa. Pyorista korjaa sen. D2007 versioon korjautunut.
  • RoundTo
  •  Ceil
    • Pyöristä ylöspäin 17,01 → ceil(17,01*10)/10 → 17,10

Päiväys

  • function Date:TDateTime;
    • palauttaa nykyisen päiväyksen DateTime tyyppinä
  • function DateTimeToStr(DateTime: TDateTIme):String;
    • muuntaa annetun päiväyksen / kellonajan merkkijonoksi windowin asetusten mukaan.
  • function DateToStr (Date: TDateTime): String;
    • muuntaa annetun päiväyksen merkkijonoksi windowsin asetusten mukaan.
  • function DayOfWeek (date: TdateTime):Integer;
    • palauttaa viikonpäivän numerovälillä su (1) .. la (7)
  • function DayOfTheWeek (date: TdateTime):Integer;
    • palauttaa viikonpäivän numerovälillä ma (1) .. su (7). ANSI -standardin mukainen.
  • function SqlDateToDate(dateString: String): Tdatetime;
    • Muuttaa yyyy-mm-dd muotoisen päiväysmerkkijonon sisäiseksi Tdatetime -tyypiksi.
  • DecodeDate
  • DecodeTime
  • EncodeDate
  • EncodeTime
  • IsLeapYear
  • StrToDate
  • StrToDateTime
  • Functon Now: TdateTime
    • palauttaa nykyhetken
  • function FormatDateTime(format: string; DateTime: Tdatetime):String;
    • Muotoilee ajan ja päivän annetulla formaatilla kts.
  • StrToTime
  • Time
  • TimeToStr
  • formatdatetime('yyyy-mm-dd hh:nn:ss', d);
  • formatdatetime('yyyy-mm-dd', d);

Bonuslaskenta

  • function AlustaBonus(Tietokanta): Bonusluokka;
    • lataa bonusasetukset. Kutsu vain kerran ja jokaista AlustaBonus rutiinin kutsua kohden pitää kutsua vapautabonus.
  • procedure VapautaBonus(Bonusluokka);
    • vapauttaa aiemmin AlustaBonus funktiolla luodun bonusmuuttuja.
  • function BonusPros(kertyma:Double): Double;
    • palauttaa bonusprosentin johon ostokertymä oikeuttaa

Tietokanta

Titan -komponentin liityntä tauluun luodaan seuraavasti

Code Block
languagedelphi
Tuotetaulu := TTbTable.create(nil);
tuotetaulu.tablename := 'tuote';
tuotetaulu.databasename := 'testikanta';
tuotetaulu.open;
... ja lopuksi
tuotetaulu.free;
  • function TTbTable.TryEdit (ms_viive: integer);

    • tTbTable-luokan menetelmä. Yrittää saada muokkausoikeuden taulun nykyiseen tietueeseen ja yritetään korkeintaan ms_viiveen ajan. Aika on millisekunteina. Palauttaa false jos epäonnistui, esim.

      Code Block
      languagedelphi
      if not tuote.tryedit(2000) then
  showmessage('Tuotetta ei voi muokata');


  • function TTbTable.TryPost (ms_viive: integer);

    • tTbTable-luokan menetelmä. Yrittää saada muokkausoikeuden taulun nykyiseen tietueeseen ja yritetään korkeintaan ms_viiveen ajan. Aika on millisekunteina. Palauttaa false jos epäonnistui, esim.

      Code Block
      languagedelphi
      if varsaldo.tryEdit(2000) then
begin
  varsaldo.fieldbyname('saldo').asfloat := 0;
  varsaldo.fieldbyname('muutosklo').asdatetime := now;
  if not varsaldo.trypost(2000) then
  begin
    logentry('Varsaldoa ei voi tallentaa');
    varsaldo.cancel;
  end;
end
else
  showmessage('Saldoa ei voi muokata');


Pervasive sql

Hakuindeksin vaihtaminen; esim toimittajataulussa key0=tunnus, key1 nimi, jos halutaan hakea nimellä vaihdetaan haun kohdistuminen niin käytetään:  taul.indexname := '1';

Tällä voi tarkistaa onko joku taulu olemassa: Select count(*) from X$File where Xf$Name = 'taulunnimi' , palauttaa 1 jos taulu olemassa


Koska pervasiven PDAC komponenttikirjastoista ei ole saatavilla lähdekoodeja, siitä emme ole voineet tuottaa titan rajanpinnan kaltaista liittymää. Sql rajapinta on tehty omilla rutiineilla jotka ovat

  • function LuoSql(TietokantaAlias, sql, tapa) - luo kyselyn ja palauttaa sen muuttujan (jatkossa alla kysely). Voidaan myös lisätä suoraan sql parametriksi esim. q := luosql(dbname,'select count ( * ) as c from from tuote'); joka tekee luonnin lisäksi sql lauseen asettamisen. Vapaaehtoinen 3. parametri tapa voidaan myös antaa. Se voi olla välillä 1-3, 1= avaa kyselyn, 2 = ajaa kysely (update, insert, delete tms), 3= ajaa kyselyn ja vapauttaa sql muutujan. Kun tapa=3, paluu arvona on vaikutettujen rivien määrä.
  • procedure VapautaSql(Kysely) - vapauttaa LuoSql:llä luodun kysely
  • procedure Asetasq(Kysely, SqlLause) - asettaa kyselylle sqllauseen
  • procedure Avaasql(kysely) - avaa sql lauseen esim. raportointia tai aineiston muuta läpikahlausta varten
  • procedure AjaSql(kysely) - ajaa sql lauseen esim. update, insert tai delete.
  • procedure SuljeSql(kysely) - sulkee sql kyselyn
  • function eofSql(kysely) - palautaa True jos kysely on loppu
  • function SqlFirst(kysely) - palaa ensimmäiseen tietueeseen
  • function Sqlnext(kysely) - siirtyy seuraavaan tietueeseen
  • function SqlPrev(kysely) - siirtyy edelliseen tietueeseen
  • function SqlLast(kysely) - siirtyy viimeiseen tietueeseen
  • function Sqlfbi(kysely,kentta) - palauttaa avatusta kyselystä kentän integerinä
  • function Sqlfbb(kysely,kentta) - palauttaa avatusta kyselystä kentän Booleanin
  • function Sqlfbs(kysely,kentta) - palauttaa avatusta kyselystä kentän stringinä
  • function Sqlfbd(kysely,kentta) - palauttaa avatusta kyselystä kentän DateTimeä

Huom! Kysellessä memokenttiä (tuotetxt.teksti, astxt.teksti tms) joiden sisältö on yli 1024 merkkiä, tulee virhe.
Sen voi kiertää ainakin jossain määrin muuttamalla kyselyn "select tuotenro, teksti from tuotetxt" muotoon "select tuotenro, convert(teksti,sql_varchar) as teksti from tuotetxt".
Toinen vaihtoehto on käyttää taulukomponenttia.

Code Block
languagedelphi
kysely := LuoSql('testikanta');
asetasql(kysely,'select tuote,sum(summa) as myynti from tuotemyy where tuotelaji in (0,2) and pvm>''2011'' ');
avaasql(kysely);
while not eofsql(kysely) do
begin
  showmessage(sqlfbs(kysely,'tuote')+' '+formatfloat('#0.00',sqlfbf(kysely,'myynti')));
  sqlnext(kysely);
end;
suljesql(kysely);
vapautasql(kysely);

kysely1 := CreateSql('testikanta','select count(*) as maara from tuote where ryhma = :r');
preparesql(kysely1);
for i := 1 to 10 do
begin
  sqlSetParam(kysely1,'r',i);
  opensql(kysely1);
  showmessage('Tuoteryhmässä '+inttostr(i)+' on tuotteita '+inttostr(sqlfbi(kysely1,'maara')));
  closesql(kysely1);
end;
unprepareSql(kysely1);
vapautasql(kysely1);

Excel liityntä

Excel yhteys perustaa AdoDb:n. Esimerkki avauksesta, tässä excel avataan vain luku tilaan. Lisäksi kerromme että headereita ei ole (HDR=NO) jolloin kentät ovat f1, f2 jne sekä excel ei yritä päätellä datatyyppejä (IMEX=1). Jälkimmäinen on tarpeen jos siellä on tyhjiä tai sekalaisia arvoja samassa sarakkeessa. 

Code Block
languagedelphi
var
  q;
begin
  q := TAdoQuery.Create(nil);
  // onko uudempi xcls
  if pos('.XLSX', Uppercase(lahdetiedosto) )  = length(lahdetiedosto)-4 then                            
  'f4 as paaryhma,f5 as tuoteryhma ,f6 as aliryhma,  q.connectionString :='Provider=Microsoft.ACE.OLEDB.12.0;Data Source='+lahdetiedosto+';'+
           'Extended     'f7 as vero,f8 as toimittaja,f9 as hinta,f10 as keskihinta,f11 as tilauskoko,f12 as hrkerroin, f13 as hryksikko, Properties="Excel 12.0 Xml;HDR=No;IMEX=1"'
 else
    q.connectionString :='Provider=Microsoft.JET.OLEDB.4.0;Data Source='+lahdetiedosto+';'+
           'Extended Properties="Excel 8.0;HDR=No;IMEX=1"'
  'f14q.sql.text := 'select f1 as vyksnumero, f15f2 as mykstilauskoodi, f16f3 as tilyksnimi, f17 as lisatunnus, '+
                'f18f4 as varipaaryhma,f5 f19as astuoteryhma koko, f20f6 as viivakoodialiryhma, '+
                'from [Tuote$]';
  q.active := true;
  while not q.eof do
  beginf7 as vero,f8 as toimittaja,f9 as hinta,f10 as keskihinta,f11 as tilauskoko,f12 as hrkerroin, f13 as hryksikko, '+
     showmessage(q.fieldbyname('numero').asstring+' '+q.fieldbyname('nimi').asstring);           'f14 as vyks, f15 as myks, f16 as tilyks, f17 as lisatunnus, '+
        q.next;   end;    q.close; 'f18  q.free;

Kun exceliä haluataan kirjoitttaa, pitää Extended properties olla 'Extended Properties="Excel 12.0 Xml;ReadOnly=False;HDR=YES" (kun siis uudempi excel) eli HDR on pakollinen ja IMEX ei saa olla. Alla muutama esimerkki update/insert lauseesta.

Code Block
languagedelphi
  q.sql.text := 'insert into [Tuote$] (tuotenumero, tilauskoodi, nimi) values (''kenttä1'', ''kenttä2'', ''kenttä3'')'as vari, f19 as koko, f20 as viivakoodi '+
                'from [Tuote$]';
  q.execsqlactive := true;
  while not q.sql.text := 'update [Tuote$] set NIMI = ''aa'', TILAUSKOODI=''bb'', HRKERROIN=10.32 where TUOTENUMERO=''kenttä1'' ';eof do
  begin 
    showmessage(q.fieldbyname('numero').asstring+' '+q.fieldbyname('nimi').asstring);
    q.next;
  end; 
  q.execsqlclose;
   q.q.free;


Kun exceliä haluataan kirjoitttaa, pitää Extended properties olla 'Extended Properties="Excel 12.0 Xml;ReadOnly=False;HDR=YES" (kun siis uudempi excel) eli HDR on pakollinen ja IMEX ei saa olla. Alla muutama esimerkki update/insert lauseesta.

Code Block
languagedelphi
  q.sql.text := 'updateinsert into [Tuote$] set NIMI = ''aa (tuotenumero, tilauskoodi, nimi) values (''kenttä1'', TILAUSKOODI=''bbkenttä2'', [OH (sis ALV)]=10.42''kenttä3'')';
  q.execsql;

  q.sql.text := 'update [Tuote$] set NIMI = ''aa'', TILAUSKOODI=''bb'', HRKERROIN=10.32 where TUOTENUMERO=''VARITUOTE1kenttä1'' ';
  q.execsql;

64 bittisessä ympäristössä uuden excel driverin kanssa voi olla ongelmaa, jos se ei toimi, kannattaa kokeilla 2007 versio ajuria
https://www.microsoft.com/en-us/download/details.aspx?id=23734

Excel välilehtien luku

Code Block
languagedelphi
var
  lahdetiedosto,q;
  con;
  ds: TAdoDataSet;
  lista;
begin
  lista := tstringlist.create;
  LahdeTiedosto := 'c:\temp\testi.xlsx';
  ds := TAdodataSet.create(nil);   // dataset taulurakenteen hakuun
  // Luodaan ADODb:llä 

  q.sql.text := 'update [Tuote$] set NIMI = ''aa'', TILAUSKOODI=''bb'', [OH (sis ALV)]=10.42 where TUOTENUMERO=''VARITUOTE1'' ';
  q.execsql;


64 bittisessä ympäristössä uuden excel driverin kanssa voi olla ongelmaa, jos se ei toimi, kannattaa kokeilla 2007 versio ajuria
https://www.microsoft.com/en-us/download/details.aspx?id=23734

Excel välilehtien luku

Code Block
languagedelphi
var
  lahdetiedosto,q;
  con;
  ds: TAdoDataSet;
  lista;
begin
  lista := tstringlist.create;
  LahdeTiedosto := 'c:\temp\testi.xlsx';
  ds := TAdodataSet.create(nil);   // dataset taulurakenteen hakuun
  // Luodaan ADODb:llä excel yhteys
  con := TAdoconnection.create(nil);
  con.connectionstring := 'Provider=Microsoft.ACE.OLEDB.12.0;Data Source='+lahdetiedosto+';'+
           'Extended Properties="Excel 12.0 Xml;HDR=No;IMEX=1"';
  con.loginprompt := false; // ei suotta kysely  käyttäjätunnusta
  con.OpenSchema(20,emptyparam, emptyparam, ds);
  while not ds.eof do
  begin
    lista.add(ds.fieldbyname('TABLE_NAME').asstring);
    ds.next;
  end;
  // tässä kohden meillä on selvillä välilehtien nimet lista-nimisessä merkkijono listasas
  logentry('välilehdet ovat:');
  logentry(lista.text);
  // avataan kysely ekalle välilehdelle 
  q := TAdoQuery.Create(nil);
  Q.connection := con;
  q.sql.text := 'select '+
                'f1 as paaryhma, '+
                'f2 as ryhma, '+
                'f7 as nimi, '+
                'f15 as lvv, '+
                'f17 as viimostohinta, '+
                'f18 as keskihinta '+
                'from ['+lista.strings[0]+']';
  q.active := true;


  // sitten jatketaan normalisti

...

  • function OnkoParam(parametri): string;
    • Palauttaa parametrin arvon tai vakion NOPARAM jos parametria ei ole annettu. Esim.
      lahdetiedosto := onkoparam('lahde');
      if lahdetiedosto = NOPARAM then
      lahdetiedosto := 'c:winskjdata.txt';
      komentorivillä parametri olisi annettu skjscript /f:skriptinnimi.pas /run /lahde:c:\data\joku.txt
  • function runexe(ohjelma, parametrit): integer;
    • Ajaa ohjelman ja antaa sille parametrit. Odottaa ohjelman loppumisen.

FTP /SFTP

  • procedure LuoFtp(Serveri,Username,password: String; Ftp: tFtpLuokka)
    • avaa passiivi ftp -yhteyden serveriin. Jos serverin nimessä perässä lukee ;PASSIVE pakotetaan passiivi -yhteys, jos jotain muuta esim ;A tai ;ACTIVE tulee aktiivi -yhteys. Ftp -muuttujassa palaa ftp-luokka
    • Ftp <>0 jos toiminto onnistunut.

...

SKJ Tuote import

export-Xml kompontin ohjeita voi lukea täältä, hieman joutuu soveltamaan mutta kohtuu hyvä viite.  https://docs.microsoft.com/en-us/previous-versions/windows/desktop/ms766487(v=vs.85)

SKJ Tuote import

export-lause taustaa varten, jotta saadaan jo olemassa olevasta kannasta tiedot muokattavaksi:

...

Code Block
languagedelphi
    a := jsonnewdoc;  // luodaan dokumentti
    a := jsonaddvalue(a,'nimi','KOISTINEN');   // asetaa dokumenttiin kentän "nimi" arvoon "KOISTINEN", kohde dokumentti on 1. parametri ja uusi dokumentti on fuktion paluuarvo
    a := jsonaddvalue(a,'osoite':'sotinkatu 4c');
    // {"nimi":"KOISTINEN","osoite","sotinkatu 4c"}
    a := jsonsetvalue(a,'osoite':'Sorinkatu 4c');
    // {"nimi":"KOISTINEN","osoite","sorinkatu 4c"}
    b := jsonnewdoc; // uusissa versiossa voi sanoa suoraan b := jsonaddvalue(null, 'gsm','0500..'); kun ensimmäistä kenttää laitetaan ja luodaan dokumentti samalla
    b := jsonaddvalue(b, 'gsm','0500..'); 
    a := jsonaddvalue(b, 'puhelimet',b); 
    // {"nimi":"KOISTINEN","osoite":"sorinkatu 4c","puhelimet":{"gsm":"0500.."}}
    showmessage(a); // pitäisi näyttää json sisältö

Alla otetaan jsonia ja muutetaan se olioksi

Code Block
  b:= JsonNewDocFromjson('{"id":"A000173","group":12,"department":1,"float":12.32,"name":"3.3. A3 + F1 P4suora erikois","name2":""}');
  maara := jsongetcount( b );
  id := jsongetvalue(b, "id"); 
  for i:= 0 to jsongetcount(b)-1 do
  begin
    showmessage(jsongetname(b,i)+'='+jsontostring ( jsongetvalue(b,i,true)));  
  end;

REST Rajapinta

function RestCall(Url: string; data: String; BasicAuth_username: string; Basic_Auth_password: string; var status: integer; var statustxt: string; method: string='post'): string;

Tällä funktiolla voidaan tehdä rest kutsu. vaatii restcall.dll:n olemassaolon, tämä dll päivittyy skj:n mukana.  Parametri

  • URL: osoite ja parametrit esim https://api.liittyma.com/setproductdata?identification=foobar
  • data: Post metodin lähetettävä data. jos method on get, tämän voi jättää tyhjäksi
  • Basic_Auth_username, Basic_Auth_password jos palvelin haluaa basica autentication niin niiden salasanat
  • status: muuttuja johon laitetaan pyynnön status. 200 = OK
  • statustxt: status selväkielisenä
  • method: kutsun metodi joko post (oletus, ei tarvitse laittaa) tai get. Kirjankoolla ei väliä.
  • Paluuarvona tulee palvelimen lähetämä vastaus
Code Block
languagedelphi
var
  s,s1,status,statustxt;
  b,n;
  nro;
begin4c');
    // {"nimi":"KOISTINEN","osoite","sotinkatu 4c"}
    a := jsonsetvalue(a,'osoite':'Sorinkatu 4c');
    // {"nimi":"KOISTINEN","osoite","sorinkatu 4c"}
    b := jsonnewdoc; // uusissa versiossa voi sanoa suoraan b := jsonaddvalue(null, 'gsm','0500..'); kun ensimmäistä kenttää laitetaan ja luodaan dokumentti samalla
    b := jsonaddvalue(b, 'gsm','0500..'); 
    a := jsonaddvalue(b, 'puhelimet',b); 
    // {"nimi":"KOISTINEN","osoite":"sorinkatu 4c","puhelimet":{"gsm":"0500.."}}
    showmessage(a); // pitäisi näyttää json sisältö


Alla otetaan jsonia ja muutetaan se olioksi

Code Block
  b:= JsonNewDocFromjson('{"id":"A000173","group":12,"department":1,"float":12.32,"name":"3.3. A3 + F1 P4suora erikois","name2":""}');
  maara := jsongetcount( b );
  id := jsongetvalue(b, "id"); 
  for i:= 0 to jsongetcount(b)-1 do
  begin
    showmessage(jsongetname(b,i)+'='+jsontostring ( jsongetvalue(b,i,true)));  
  end;


REST Rajapinta

function RestCall(Url: string; data: String; BasicAuth_username: string; Basic_Auth_password: string; var status: integer; var statustxt: string; method: string='post'): string;

Tällä funktiolla voidaan tehdä rest kutsu. vaatii restcall.dll:n olemassaolon, tämä dll päivittyy skj:n mukana.  Parametri

  • URL: osoite ja parametrit esim https://api.liittyma.com/setproductdata?identification=foobar
  • data: Post metodin lähetettävä data. jos method on get, tämän voi jättää tyhjäksi
  • Basic_Auth_username, Basic_Auth_password jos palvelin haluaa basica autentication niin niiden salasanat
  • status: muuttuja johon laitetaan pyynnön status. 200 = OK
  • statustxt: status selväkielisenä
  • method: kutsun metodi joko post (oletus, ei tarvitse laittaa) tai get. Kirjankoolla ei väliä.
  • Paluuarvona tulee palvelimen lähetämä vastaus
  • D10 versiossa (29.6.2020) on metodin jälkeen valinnainen headers parametri, joka on muotoa stringlist 
Code Block
languagedelphi
var
  s,s1,status,statustxt;
  b,n;
  nro;
  sl;
begin
  sl := tstringlist.create;
  sl.values['Authorization']:='bearer   xxxxxxx'; // tämä siis toimii vain D10 versiosaa
  s := restCall('https://t.skj.fi/tapahtuma/products?apikey=wont_tell_you','{"name":"taas uusi tuote"}', '', '', status, statustxt, sl);
  showmessage(s+#13+inttostr(status)+#13+inttostr(statustxt));
  if status=200 then
  begin
    b:= JsonNewDocFromjson(s);        // b on koko dokkari 
    n := jsongetvalue(b,'products');  // n : products elementti, joka on array yhdestä tuotteesta
    n := jsongetvalue(n,0,true);      // n on tämän jälkeen eka alkio tuotearraysta
    nro := jsongetvalue(n,'id');      // otetaan vastauksesta id - tuotenumero
    s1 := restCall('https://t.skj.fi/tapahtuma/products/'+nro+'?apikey=wont_tell_you','', '', '', status, statustxt,'get');
    showmessage(s1);  // s ja s1 pitäisi olla samat
    b := jsonnewdoc;
    b := jsonaddvalue(b, 'id', nro);
    b := jsonaddvalue(b, 'group', 12);
    b := jsonaddvalue(b, 'name', 'lahden kotiin');
    s := restCall('https://t.skj.fi/tapahtuma/products?apikey=wont_tell_you','{"name":"taas uusi tuote"}' b, '', '', status, statustxt);
    showmessage(s+#13+inttostr(status)+#13+inttostr(statustxt)););
  end;           if status=200 then   begin     b:= JsonNewDocFromjson(s);           // b on koko dokkari      n := jsongetvalue(b,'products');  // n : products elementti, joka on array yhdestä tuotteesta     n := jsongetvalue(n,0,true);      //
n on tämän jälkeen eka alkio tuotearraysta
    nro := jsongetvalue(n,'id');      // otetaan vastauksesta id - tuotenumero
    s1 := restCall('https://t.skj.fi/tapahtuma/products/'+nro+'?apikey=wont_tell_you','', '', '', status, statustxt,'getsl.free;
end;


Jatkuva toiminta

Skjscript voidaan laittaa pöyrimään taustalle silmukassa esim lähettämään muutoksia aikaajoin. Tähän pitää rakentaa myös poistumismekanismi. Jos ohjelma pyörii näkyvillä työasemassa, voidaan se hoitaa aiemmilla versiolla, mutta palveluna vaati 28.9.2018 tai uudemman version.

Code Block
languagedelphi
var
  postaaja;
  s;
  laskuri;
  st;
begin
  st := CreateStatus('Päivitys');
  laskuri  showmessage(s1);:= 0;
  // s ja s1 pitäisi olla samat
    b := jsonnewdoc;
    b := jsonaddvalue(b, 'id', nro); allaoleva showstatus palauttaa false jos käyttäjä on painanut peruuta tai skjscript
  // on saanut wm_close viestin. esim process -q skjscript.exe
  while showstatus(st,'Päivitän asiakasdataa ','Päivitetty '+inttostr(laskuri)) do
  begin

      bpostaaja := jsonaddvalue(b, 'group', 12)LuoPostaaja;
    b := jsonaddvaluepostaaja_lisaakentta(bpostaaja, 'nameid', 'lahden kotiin1212');
    s := restCall('https://t.skj.fi/tapahtuma/products?apikey=wont_tell_you', b, '', '', status, statustxt);
    showmessage(spostaaja_lisaakentta(postaaja,'data','adadada');
  end;    s := postaaja_post(postaaja,'https://jotain.skj.fi/joku.php','');
      logentry('vastaus'+s);
      sleep(1000);
      inc(laskuri);
      logentry('virhe'+postaaja_virhe(postaaja));
      postaaja_sulje(postaaja);
   end;
                      
end;

Jatkuva toiminta

...

closestatus(st);
end;



Uudet funktiot (D10 versio)

Code Block
function LisaaAsiakas(kanta: string; Numero:integer=0; valialku, valiloppu: integer=0): integer

Lisää asiakkaan ja palauttaa lisätyn numeron. Parametrina voidaan antaa numeroväli ja numero. Palauttaa -1 jos epäonnistuu. Asikkaasta lisään vaan numerot. ei muita tietoja.


Code Block
function PaivitaAsiakas(kanta: string; Numero:integer; data: docvar): boolean

Päivittää asiakkaan tiedot "json-dokkarista" eli muuttujasta joka on luotu esim JsonNewDocFromjson. json dokumenttien kenttänimet pitää vastata asiakastaulun kenttänimiä


Tekstitiedoston muutos UTF8→ansi. Voi olla tarpeen jos käsitellään tiedostoa jollain esim d2007 versiolla tehdyällä ohjelmalla.

Code Block
languagedelphi
varsl   postaaja;
  s;
  laskuri;
  st;
begin
  st := CreateStatus('Päivitys');
  laskuri := 0;
  // allaoleva showstatus palauttaa false jos käyttäjä on painanut peruuta tai skjscript
  // on saanut wm_close viestin. esim process -q skjscript.exe
  while showstatus(st,'Päivitän asiakasdataa ','Päivitetty '+inttostr(laskuri)) do
  begin

      postaaja := LuoPostaaja;
      postaaja_lisaakentta(postaaja,'id','1212');
      postaaja_lisaakentta(postaaja,'data','adadada');
      s := postaaja_post(postaaja,'https://jotain.skj.fi/joku.php','');
      logentry('vastaus'+s);
      sleep(1000);
      inc(laskuri);
      logentry('virhe'+postaaja_virhe(postaaja));
      postaaja_sulje(postaaja);
   end;
  closestatus(st);
end;

Uudet funktiot (D10 versio)

Code Block
function LisaaAsiakas(kanta: string; Numero:integer=0; valialku, valiloppu: integer=0): integer

Lisää asiakkaan ja palauttaa lisätyn numeron. Parametrina voidaan antaa numeroväli ja numero. Palauttaa -1 jos epäonnistuu

Code Block
function PaivitaAsiakas(kanta: string; Numero:integer; data: docvar): boolean

...

:= tstringlist.create;
sl.loadfromfile('unicodefile.txt');
sl.converttoansi;
sl.savetofile('ansifile.txt');sl.free;


Myynti2skj tiedoston tuottaminen

Tällä voidan tehdää myynti2skj hyväksymää tiedostomuotoa.  Logiikka mene karkeasti

  1. luo luokka
  2. kutsu aloita
  3. kutsu tuoterivejä ja tekstirivejä haluttu määrä. Ulosmaksut/kassaanmaksut tulossa
  4. lisää maksutapa (summien pitäisi täsmätä rivien summaan)
  5. kutsu lopeta
  6. tallenna tiedostoa 
Code Block
languagedelphi
var
  m:tmyynti2skjtiedostoluoja;
  sl;
begin 
  m := tmyynti2skjtiedostoluoja.create;
  sl := tstringlist.create;
  // aika, tosite, myymälä, kassa, myyjä, asiakas, tyyppi (0=normaali,1=tositetallennus)
  m.aloita(now, 100,1,'00099',10,0,0); 
  // tuote,määrä, ahinta, alepros, alvpros, yht
  m.lisaatuote('100221', 2, 50, 5, 24, 95);
  m.lisaaTekstiRivi('Tuotteella ei ole takuuta');
  // maksutavan nro, summa, erikoistoiminto, annettusumma
  m.lisaaMaksutapa(2,95,0,0);
  m.lopeta( sl ); 
  sl.savetofile('c:\temp\tosite.txt');
end;