home *** CD-ROM | disk | FTP | other *** search
/ Chip 1997 April / Chip_1997-04_cd.bin / tema / 602propc / disk5 / data.5 / WINTIME / APPS / I_EXPIMP.PGM < prev    next >
Text File  |  1996-12-03  |  18KB  |  453 lines
  1. Include
  2.  
  3. procedure DoStringu(str : string[10];cis : short);
  4. {**************************************}
  5. begin
  6.   if patrs[cis] <> '' then begin
  7.     StrInsert(str,SQLinsert,ukaz1);
  8.     ukaz1 := ukaz1+StrLength(str);
  9.     StrInsert(",",SQLinsert,ukaz1);
  10.     ukaz1 := ukaz1+1;
  11.     ukaz2 := ukaz2+StrLength(str)+1;
  12.     StrInsert(patrs[cis],SQLinsert,ukaz2);
  13.     ukaz2 := ukaz2+StrLength(patrs[cis]);
  14.     StrInsert(",",SQLinsert,ukaz2);
  15.     ukaz2 := ukaz2+1;
  16.   end;
  17. end;
  18.  
  19. procedure AkceImport;
  20. {**************************************}
  21. {provede naΦtenφ dat z DBF souboru a p°idßnφ do tabulky;
  22. popis p°enosu si u₧ivatel definuje v pohledu sßm}
  23. var
  24.   ss : string[80]; 
  25.   f : file;
  26.   znak : char;
  27.   znak32 : array[0..32] of char;
  28.   j,i : integer;
  29.   pocetAtr : integer;
  30.   pomstr : string[3];
  31.   pozice : short;
  32.   err : boolean;
  33.   recins : integer;
  34.   spopis : string[20];
  35. begin
  36.   ss := 'C:\*.DBF';
  37.   if Select_file(0,ss) then 
  38.     if (StrCopy(ss,StrLength(ss)-2,3)='DBF') or (StrCopy(ss,StrLength(ss)-2,3)='dbf') then begin
  39.       Reset(f,ss);                       // otev°enφ DBF souboru
  40.       Set_status_text("NaΦφtßm hlaviΦku DBF souboru");
  41.       for i := 0 to 31 do begin
  42.         Read(f,znak);
  43.         znak32[i] := znak;
  44.       end;                              // zjiÜt∞nφ poΦtu field∙ z hlaviΦky souboru
  45.       pocetAtr := Trunc((256*Ord(znak32[9])+Ord(znak32[8])-1)/32-1);
  46.    
  47.       for j := 1 to pocetAtr do begin   // naΦtenφ jmen a typ∙ field∙ do pole
  48.         Set_status_nums(j,pocetAtr);
  49.         for i := 0 to 31 do begin
  50.           Read(f,znak);
  51.           znak32[i] := znak;
  52.         end;
  53.         pomstr := Ord(znak32[16])<10?"00"+int2str(Ord(znak32[16])): 
  54.                       Ord(znak32[16])<100?"0"+int2str(Ord(znak32[16])):
  55.                                           int2str(Ord(znak32[16]));
  56.         pole[j][1] := znak32[11];
  57.         pole[j][2] := ' ';
  58.         pole[j][3] := pomstr[1];
  59.         pole[j][4] := pomstr[2];
  60.         pole[j][5] := pomstr[3];
  61.         pole[j][6] := ' ';
  62.         pole[j][7] := ' ';
  63.         pole[j][8] := ' ';
  64.         for i := 0 to 10 do 
  65.           pole[j][i+9] := znak32[i];
  66.         pole[j][20] := Chr(0);
  67.       end; // j cyklus
  68.  
  69.       Set_status_nums(-1,-1);
  70.       Set_status_text("");
  71.        
  72.       expkod := 0;
  73.       zrusitAkci := true;
  74.       err := false;
  75.       spomx := 'Import dat z DBF do skupiny: '+nazskup;
  76.       Open_view("*Pdbf", no_redir,0,0,0,id_dbf);
  77.       hlist := GetDlgItem(id_dbf,3);         // zjiÜt∞nφ handle seznamu
  78.       repeat Peek_message until id_dbf=0;
  79.       if not zrusitAkci then begin
  80.         if not Find_object('__TEMP__',categ_table,pozice) then SQL_execute('DROP TABLE __TEMP__');
  81.         Set_status_text('P°enos dat z DBF souboru do pomocnΘ tabulky..');
  82.         if not Data_import('__TEMP__',true,ss,4,expkod) then begin // import DBF do pomocnΘ tabulky
  83.           Info_box('Chyba','Data_import');
  84.           err := true;
  85.         end  
  86.         else begin              // posklßdßnφ SQL p°φkazu INSERT z popisu v pohledu
  87.           SQLinsert := 'INSERT INTO Tfirma(skupina,) SELECT '+Int2str(skup)+', FROM __TEMP__';
  88.           ukaz1 := 28; ukaz2 := 39;
  89.           DoStringu('jmeno',1);
  90.           DoStringu('prijmeni',2);
  91.           DoStringu('titul',3);
  92.           DoStringu('funkce',4);
  93.           DoStringu('firma',5);
  94.           DoStringu('ulice',6);
  95.           DoStringu('mesto',7);
  96.           DoStringu('psc',8);
  97.           DoStringu('stat',9);
  98.           DoStringu('telefon',10);
  99.           DoStringu('fax',11);
  100.           DoStringu('mail',12);
  101.           DoStringu('ico',13);
  102.           DoStringu('dic',14);
  103.           DoStringu('banka',15);
  104.           StrDelete(SQLinsert,ukaz1-1,1);           // umazßnφ Φßrek za poslednφmi atributy
  105.           StrDelete(SQLinsert,ukaz2-2,1);           
  106.  
  107.           Set_status_text('P°enos dat z pomocnΘ tabulky do tabulky firem...');
  108.           Enable_index(Tfirma,-1,false);
  109.           if SQL_execute(SQLinsert) then  begin     // p°enos dat z pom. tabulky do Tfirma
  110.             err := true;
  111.             Info_box('Chyba SQL','import dat');
  112.           end;  
  113.           Set_status_text('Vybudovßnφ index∙...');
  114.           Enable_index(Tfirma,-1,true);
  115.           if SQL_execute('DROP TABLE __TEMP__') then begin // zruÜenφ pomocnΘ tabulky
  116.             err := true;
  117.             Info_box('Chyba SQL','mazßnφ tabulky');
  118.           end;  
  119.           if not Close_cursor(curmain) then begin   // zav°enφ a znovuotev°enφ hlavnφho kurzoru, aby se promφtly zm∞ny
  120.             ss := 'SELECT * FROM Tfirma WHERE skupina='+Int2str(skup);
  121.             if Open_sql_cursor(curmain,ss) then Signalize;
  122.           end;  
  123.           if id > 0 then Reset_view(id,-1,5);       // p°ekreslenφ pohled∙
  124.           if id_sez > 0 then Reset_view(id_sez,-1,5);  
  125.  
  126.           Set_status_text('');
  127.           if not err then begin
  128.             if YesNo_box('P°enos zßznam∙','P°enos prob∞hl OK.'#10'Chcete tento import ulo₧it pro p°φpadnΘ dalÜφ pou₧itφ?') then  begin
  129.               recins := Append(Tinserty);
  130.               if recins <> -1 then begin
  131.                 with Tinserty[recins] do begin
  132.                   soubor := ss;
  133.                   insertstr[0,StrLength(SQLInsert)] := SQLInsert;
  134.                   cisloi := recins;
  135.                   datum := Today;
  136.                   spopis := '';
  137.                   Input_box('Zadejte jmΘno importu',spopis,20);
  138.                   popis := spopis;
  139.                   kodi := expkod;
  140.                 end;
  141.                 Uninst_table(Tinserty);
  142.               end
  143.               else Info_box('Ulo₧enφ importu','Nepoda°ilo se ulo₧it import!');  
  144.             end;
  145.           end  
  146.           else Info_box('Import','Akce neprob∞hla ·sp∞Ün∞!');
  147.  
  148.         end; // else 
  149.       end; // zrusitAkci;
  150.     end else Info_box('Chyba','Vybran² soubor nenφ DBF soubor!');
  151.     Close(f);
  152. end;    
  153.  
  154. procedure AutoImport(cis : short);
  155. {**************************************}
  156. {import dat podle d°φve ulo₧enΘho popisu}
  157. var
  158.   unt : untyped;
  159.   recins2 : integer;
  160.   pozice : short;
  161.   err : boolean;
  162.   ss : string[100];
  163. begin
  164.   err := false;
  165.   unt := cis;
  166.   recins2 := Look_up(Tinserty,'cisloi',unt);
  167.   if recins2 <> -1 then 
  168.     with Tinserty[recins2] do begin
  169.       SQLInsert := insertstr[0,insertstr#];
  170.       expkod := kodi;
  171.  
  172.       if not Find_object('__TEMP__',categ_table,pozice) then SQL_execute('DROP TABLE __TEMP__');
  173.       Set_status_text('P°enos dat z DBF souboru do pomocnΘ tabulky...');
  174.       if not Data_import('__TEMP__',true,soubor,4,expkod) then begin // import DBF do pomocnΘ tabulky
  175.         Info_box('Chyba','Data_import');
  176.         err := true;
  177.       end  
  178.       else begin              
  179.         Enable_index(Tfirma,-1,false);
  180.         Set_status_text('P°enos dat z pomocnΘ tabulky do tabulky firem...');
  181.         if SQL_execute(SQLinsert) then  begin     // p°enos dat z pom. tabulky do Tfirma
  182.           err := true;
  183.           Info_box('Chyba SQL','import dat');
  184.         end;  
  185.         Set_status_text('Vybudovßnφ index∙...');
  186.         Enable_index(Tfirma,-1,true);
  187.         if SQL_execute('DROP TABLE __TEMP__') then begin // zruÜenφ pomocnΘ tabulky
  188.           err := true;
  189.           Info_box('Chyba SQL','mazßnφ tabulky');
  190.         end;  
  191.         if not Close_cursor(curmain) then begin   // zav°enφ a znovuotev°enφ hlavnφho kurzoru, aby se promφtly zm∞ny
  192.           if vsechnysk then ss := 'SELECT * FROM Tfirma'
  193.           else ss := 'SELECT * FROM Tfirma WHERE skupina='+Int2str(skup);
  194.           Open_sql_cursor(curmain,ss);
  195.         end;  
  196.         if id > 0 then Reset_view(id,-1,5);       // p°ekreslenφ pohled∙
  197.         if id_sez > 0 then Reset_view(id_sez,-1,5);  
  198.         Set_status_text('');
  199.         if not err then Info_box('Provedeno','Import prob∞hl OK')
  200.         else Info_box('Import','Akce neprob∞hla ·sp∞Ün∞!');
  201.       end;
  202.     end;
  203. end;
  204.  
  205. procedure ImportDBF;
  206. {**************************************}
  207. {pouze pro DB_ADMINa}
  208. var
  209.   pocet : integer;
  210.   id_imp : window_id;
  211. begin
  212.   if myName <> 'DB_ADMIN' then Info_box('Nelze','  Import dat m∙₧e provΘst pouze sprßvce databßze!')
  213.   else 
  214.     if vsechnysk then Info_box('Nelze','P°ed importem musφte mφt vybranou jednu konkrΘtnφ skupinu!')
  215.     else begin
  216.       Rec_cnt(Tinserty,pocet);
  217.       if pocet > 0 then begin
  218.         if YesNo_box('Import dat','Chcete pou₧φt d°φve definovan² import dat?') then 
  219.         begin 
  220.           zrusitAkci := true;
  221.           Open_view('*PImport',no_redir,0,0,0,id_imp);
  222.           repeat Peek_message until id_imp=0;
  223.           if not zrusitAkci then AutoImport(cis_imp);
  224.         end
  225.         else AkceImport;
  226.       end
  227.       else AkceImport;  
  228.     end;  //nenφ skupina
  229. end;
  230.  
  231. procedure PrenestZeSeznamu(kam : short);
  232. {**************************************}
  233. {procedura volanß tlaΦφtky <-- z pohledu pro popis importu}
  234. var
  235.   ind : integer;
  236.   spom : string[33];
  237.   u : untyped;
  238. begin
  239.   ind := Send_message(hlist,1033,0,0);   // zjiÜt∞nφ vybranΘ polo₧ky seznamu
  240.   if ind = -1 then Info_box('Nelze','Nenφ vybrßna ₧ßdnß polo₧ka DBF!')
  241.   else begin
  242.     spom := Get_view_item(id_dbf,kam);
  243.     if spom <> '' then spom := spom+"+"" ""+"+StrCopy(pole[ind+1],9,10)
  244.     else spom := StrCopy(pole[ind+1],9,10);
  245.     u := spom;
  246.     Set_item_value(id_dbf,0,kam,u);      // zapsßnφ jmΘna do editaΦnφho pole a do prom∞nnΘ
  247.   end; 
  248. end;
  249.  
  250. procedure Export;
  251. {**************************************}
  252. {Vyexportuje  zßznamy pro pou₧itφ v jinΘ databßzi. Aby se vyexportovaly 
  253. i hodnoty multiatributu (pro DBF a CSV), je tabulka nahrazena prom. kurzorem, 
  254. v n∞m₧ jsou prvnφ dv∞ slo₧ky multiatributu rozepsßny.}
  255. var
  256.   id_exp : window_id;
  257.   cesta : string[20];
  258.   curexp : cursor;
  259.   pomstr : string[500];
  260.   dotazex : string[300];
  261. begin
  262.   expkod := 0;
  263.   expset := 0; 
  264.   zrusitAkci := true;
  265.   Open_view("*Pexport",no_redir,0,0,0,id_exp);
  266.   repeat Peek_message until id_exp = 0;
  267.   if not zrusitAkci then begin
  268.     case exptype of
  269.       0 : cesta := 'C:\*.TDT';
  270.       2 : cesta := 'C:\*.CSV';
  271.       4 : cesta := 'C:\*.DBF';
  272.     end;
  273.     if Select_file(0,cesta) then begin
  274.       Set_cursor(1);
  275.       Set_status_text("Probφhß export dat, prosφm Φekejte...");
  276.       if expset = 0 then begin // export celΘ skupiny
  277.         if vsechnysk then begin
  278.           if exptype = 0 then     // export ve formatu WinBase
  279.             pomstr := "SELECT * FROM Tfirma ORDER BY cislo"
  280.           else
  281.             pomstr := "SELECT cislo,skupina,firma,firma2,jmeno,prijmeni,titul,muz,funkce,ulice,mesto,psc,"
  282.                       "telefon[0] AS tel1,telefon[1] AS tel2,fax[0] AS fax1,fax[1] AS fax2,mail[0] AS mail1,"
  283.                       "mail[1] AS mail2,stat,ico,dic,banka[0] AS bank1,banka[1] AS bank2,prep1,prep2,prep3,"
  284.                       "prep4,prep5,prep6,prep7,prep8,pozn FROM Tfirma ORDER BY cislo"
  285.         end
  286.         else begin
  287.           if exptype = 0 then begin
  288.             pomstr := "SELECT * FROM Tfirma WHERE skupina= ORDER BY cislo";
  289.             StrInsert(Int2str(skup),pomstr,StrLength(pomstr)-14);          
  290.           end
  291.           else begin 
  292.             pomstr := "SELECT cislo,skupina,firma,firma2,jmeno,prijmeni,titul,muz,funkce,ulice,mesto,psc,"
  293.                       "telefon[0] AS tel1,telefon[1] AS tel2,fax[0] AS fax1,fax[1] AS fax2,mail[0] AS mail1,"
  294.                       "mail[1] AS mail2,stat,ico,dic,banka[0] AS bank1,banka[1] AS bank2,prep1,prep2,prep3,"
  295.                       "prep4,prep5,prep6,prep7,prep8,pozn FROM Tfirma WHERE skupina= ORDER BY cislo";
  296.             StrInsert(Int2str(skup),pomstr,StrLength(pomstr)-14);          
  297.           end;  
  298.         end;
  299.         if Open_sql_cursor(curexp,pomstr) then Signalize
  300.         else begin
  301.           if not Data_export(curexp,categ_dircur,cesta,exptype,expkod) then Signalize
  302.           else Info_box('Provedeno','Export prob∞hl OK');
  303.           Close_cursor(curexp);
  304.         end;  
  305.       end else begin           // export vybran²ch zßznam∙
  306.         if (Active_view=id) or (Active_view=id_sez) then begin
  307.           Get_fcursor(Active_view,curexp,nil);
  308.         end else curexp := curmain;                  // urΦit∞ nenφ polo₧en QBE dotaz
  309.           if not Data_export(curexp,categ_dircur,cesta,exptype,expkod) then Signalize
  310.           else Info_box('Provedeno','Export prob∞hl OK');
  311.       end;
  312.       Set_status_text("");
  313.       Set_cursor(0);
  314.     end;  
  315.   end;
  316. end;
  317.  
  318. procedure SpocistCislo;
  319. {************************************}
  320. // pro nßsledujφcφ proceduru
  321. var
  322.   unt : untyped;
  323.   irec,erec : integer;
  324.   poslCislo : integer;
  325. begin
  326.   if C_max(Tfirma,'cislo','',unt) then begin
  327.     Signalize;
  328.   end  
  329.   else begin
  330.     poslCislo := unt;
  331.     unt := poslCislo+1;                       // o 1 v∞tÜφ ne₧ nejvyÜÜφ
  332.     if Get_view_pos(id,irec,erec) then  
  333.       Set_item_value(id,irec,54,unt);    //zapsßnφ do slo₧ky pohledu ale i do databßze
  334.   end;  
  335. end;
  336.  
  337. function PosledniCislo : short;
  338. {************************************}
  339. // klßvesa F4 nebo tlaΦφtko vedle Φφsla
  340. // je-li otev°en pohled Pfirma a dosud nenφ Φφslo, vlo₧φ a zapφÜe
  341. //                               ji₧ je Φφslo, zeptß se na vlo₧enφ
  342. // nenφ-li otev°en, oznßmφ Φφslo
  343.  
  344. var
  345.   unt : untyped;
  346.   id_cd : window_id;
  347.   irec,erec : integer;
  348.   poslCislo : short;
  349. begin
  350.   if (id > 0) and (Active_view = id) then begin     // otev°en pohled Pfirma
  351.     if (Get_view_item(id,54) <> '') then begin      // u₧ je Φφslo zapsßno
  352.       if YesNo_box('Otßzka','Chcete opravdu p°epsat ╚φslo zßznamu o firm∞ Φφslem nov²m?') then begin
  353.         SpocistCislo;
  354.       end;
  355.     end else begin  // (Get_view_item(id,54) = '') dosud nenφ zapsßno Φφslo
  356.       SpocistCislo;
  357.     end;
  358.   end;
  359.   if (id_sez > 0) and (Active_view = id_sez) then  begin      // oteve°en pohled Pseznam
  360.     if C_max(Tfirma,'cislo','',unt) then Signalize
  361.     else begin
  362.       poslCislo := unt;
  363.       unt := poslCislo+1;
  364.       Info_box('Neni₧ÜÜφ pou₧itelnΘ Φφslo',int2str(poslCislo+1));
  365.     end;  
  366.   end;
  367.   if (id=0) and (id_sez=0) then begin               // jako funkce pro import
  368.     if C_max(Tfirma,'cislo','',unt) then Signalize
  369.     else begin
  370.       poslCislo := unt;
  371.       unt := poslCislo+1;
  372.       PosledniCislo := poslCislo+1;
  373.     end;
  374.   end;
  375. end;
  376.  
  377. procedure ImportTDT;
  378. {**************************************}
  379. var
  380.   sfile : string[80];
  381.   i,rec : integer;
  382.   pocetzaz : integer;
  383.   id_vs : window_id;
  384.   ss : string[100];
  385. begin
  386.   Close_all_views;
  387.   Close_cursor(curmain);
  388.   sfile := 'C:\*.TDT';
  389.   if Select_file(0,sfile) then begin
  390.     zrusitAkci := true;
  391.     if Write_lock_table(Firmakopie) then Info_box('Nelze','Pomocnß tabulka pro import je zamknutß')
  392.     else 
  393.       Open_view('*SkupExp',no_redir,0,0,0,id_vs);
  394.       repeat Peek_message until id_vs=0;
  395.       if not zrusitAkci then begin
  396.         if Delete_all_records(FirmaKopie) then Signalize
  397.         else begin
  398.           Free_deleted(FirmaKopie);
  399.           if not Data_import('FirmaKopie',true,sfile,0,0) then Signalize 
  400.           else begin
  401.             Rec_cnt(FirmaKopie,pocetzaz);
  402.             if pocetzaz <> -1 then 
  403.               for i := 0 to pocetzaz-1 do begin
  404.                 Set_status_nums(i+1,pocetzaz);
  405.                 rec := Insert(Tfirma);
  406.                 if rec <> -1 then begin
  407.                   Start_transaction;
  408.                   Tfirma[rec].cislo   := PosledniCislo;
  409.                   Tfirma[rec].skupina := skup;
  410.                   Tfirma[rec].firma   := FirmaKopie[i].firma;
  411.                   Tfirma[rec].firma2  := FirmaKopie[i].firma2;
  412.                   Tfirma[rec].ulice   := FirmaKopie[i].ulice;
  413.                   Tfirma[rec].mesto   := FirmaKopie[i].mesto;
  414.                   Tfirma[rec].psc     := FirmaKopie[i].psc;
  415.                   Tfirma[rec].stat    := FirmaKopie[i].stat;
  416.                   Tfirma[rec].muz     := FirmaKopie[i].muz;
  417.                   Tfirma[rec].titul   := FirmaKopie[i].titul;
  418.                   Tfirma[rec].jmeno   := FirmaKopie[i].jmeno;
  419.                   Tfirma[rec].prijmeni := FirmaKopie[i].prijmeni;
  420.                   Tfirma[rec].funkce  := FirmaKopie[i].funkce;
  421.                   Tfirma[rec].telefon := FirmaKopie[i].telefon;
  422.                   Tfirma[rec].fax     := FirmaKopie[i].fax;
  423.                   Tfirma[rec].mail    := FirmaKopie[i].mail;
  424.                   Tfirma[rec].banka   := FirmaKopie[i].banka;
  425.                   Tfirma[rec].ico     := FirmaKopie[i].ico;
  426.                   Tfirma[rec].dic     := FirmaKopie[i].dic;
  427.                   Tfirma[rec].pozn    := FirmaKopie[i].pozn;
  428.                   Tfirma[rec].prep1   := FirmaKopie[i].prep1;
  429.                   Tfirma[rec].prep2   := FirmaKopie[i].prep2;
  430.                   Tfirma[rec].prep3   := FirmaKopie[i].prep3;
  431.                   Tfirma[rec].prep4   := FirmaKopie[i].prep4;
  432.                   Tfirma[rec].prep5   := FirmaKopie[i].prep5;
  433.                   Tfirma[rec].prep6   := FirmaKopie[i].prep6;
  434.                   Tfirma[rec].prep7   := FirmaKopie[i].prep7;
  435.                   Tfirma[rec].prep8   := FirmaKopie[i].prep8;
  436.                   Commit;
  437.                 end;
  438.               end;
  439.           end;
  440.         end;  
  441.       end;
  442.       Write_unlock_table(FirmaKopie);
  443.   end;
  444.   nazskup := Skupiny[skup].nazev;
  445.   s2 := 'Skupina: '+nazskup;
  446.   s4 := 'P°ehled firem skupiny: '+nazskup;
  447.   ss := 'SELECT * FROM Tfirma WHERE skupina='+Int2str(skup);
  448.   if Open_sql_cursor(curmain,ss) then Signalize;
  449.   Open_view("*Pseznam",curmain,0,0,0, id_sez);
  450.   SetWindowText(id_sez,s4);
  451. end;
  452.  
  453.