home *** CD-ROM | disk | FTP | other *** search
/ Black Box 4 / BlackBox.cdr / editors / vlite10.arj / VISAGE.PAS < prev    next >
Pascal/Delphi Source File  |  1992-04-08  |  15KB  |  566 lines
  1. {
  2. *****************************************************************************
  3. *   Copyright (c) DIDC, 1991.  All rights reserved.                          *
  4. *   Unauthorized use, duplication, or distribution is strictly prohibited.   *
  5. *****************************************************************************
  6. }
  7. {$F+}
  8. Unit VISAGE;
  9.  
  10. (************************************************************************)
  11. Interface
  12. (************************************************************************)
  13.  
  14. Uses Dos,CRT;
  15.  
  16. function DIDC_locate_tsr : boolean;
  17.  
  18. function DIDC_total_pages(var dbname : string;
  19.                           var kname : string) : integer;
  20.  
  21. function DIDC_total_pages_type(var dbname : string;
  22.                                var kname : string;
  23.                                doc_type : integer) : integer;
  24.  
  25. function DIDC_call_menu(var dbname : string;
  26.                         var kname : string;
  27.                         flag : integer;
  28.                         var DocListFname : string) : Integer;
  29.  
  30. function DIDC_tsr_type : integer;
  31.  
  32. function DIDC_batch_update :  integer;
  33.  
  34. function DIDC_set_write_vol(wv : word) : integer;
  35.  
  36. function DIDC_clear_doc_page : integer;
  37.  
  38. function DIDC_unique_key(var dbfname : string;
  39.                          var key : string;
  40.                          len : integer) : integer;
  41.  
  42. function DIDC_get_write_vol : integer;
  43.  
  44. function DIDC_show_luns : integer;
  45.  
  46. function DIDC_scan_page(var dbname : string;
  47.                         var kname : string;
  48.                         page_type : integer) : Integer;
  49.  
  50. function DIDC_auto_scan(var dbname : string;
  51.                         var kname : string;
  52.                         page_type : integer) : Integer;
  53.  
  54. function DIDC_set_scanner(page_len : integer;
  55.                           source : integer;
  56.                           intensity : integer) : integer;
  57.  
  58. function DIDC_insert_page(var dbname : string;
  59.                           var kname : string;
  60.                           page_type : integer;
  61.                           page_num  : integer) : Integer;
  62.  
  63. function DIDC_delete_page(var dbname : string;
  64.                           var kname : string;
  65.                           page_type : integer;
  66.                           page_num  : integer) : Integer;
  67.  
  68. function DIDC_get_scanner(param : integer) : Integer;
  69.  
  70. function DIDC_save_scan_set : Integer;
  71.  
  72. function DIDC_print_all_pages_type(var dbname : string;
  73.                                    var kname : string;
  74.                                    doctype : integer) : integer;
  75.  
  76. function DIDC_print_pages(var dbname : string;
  77.                           var kname : string;
  78.                           doctype : integer;
  79.                           first_page : integer;
  80.                           last_page : integer) : integer;
  81.  
  82.  
  83. function DIDC_display_page(var dbname : string;
  84.                            var kname : string;
  85.                            pagetype, page : integer;
  86.                            control : integer) : Integer;
  87.  
  88. procedure checkkf9200;
  89. (************************************************************************)
  90. IMPLEMENTATION
  91. (************************************************************************)
  92.  
  93. type
  94.   stype = array[0..50] of char;
  95.  
  96. var
  97.   DTIregs : Registers;
  98.   res     : longint;
  99.   DTIint  : word;
  100.   params  : ^stype;
  101.   strng : string;
  102.  
  103. const
  104.   DTI_TIMEOUT : integer = -555;
  105.   MAX_RETRY : integer = 10;
  106.  
  107. (************************************************************************)
  108.  
  109. function dti_done : boolean;
  110. begin
  111. if (params^[0] = chr(0)) then
  112.   dti_done  := true
  113. else
  114.   dti_done  := false;
  115. end;
  116.  
  117. (************************************************************************)
  118.  
  119. function DIDC_result : integer;
  120. var
  121.   i : integer;
  122. begin
  123. move(params^[1],i,2);
  124. DIDC_result  := i;
  125. end;
  126.  
  127. (************************************************************************)
  128.  
  129. procedure write_params(s : string);
  130. var
  131.   i : integer;
  132. begin
  133. for i  := 1 to length(s) do
  134.   params^[i-1]  := upcase(s[i]);
  135. params^[i]  := chr(0);
  136. end;
  137.  
  138. (************************************************************************)
  139.  
  140. function DIDC_call_tsr(var s : string) : integer;
  141. var
  142.   retry : integer;
  143. begin
  144. if (DTIint = 0) then
  145.   begin
  146.   DIDC_call_tsr  := 0;
  147.   exit;
  148.   end;
  149.  
  150. for retry  := 1 to MAX_RETRY do
  151.   begin
  152.   DTIregs.ax  := 1;
  153.   write_params(s);
  154.   Intr(DTIint,DTIregs);
  155.   delay(100);
  156.   if dti_done then
  157.     begin
  158.     DIDC_call_tsr  := DIDC_result;
  159.     exit;
  160.     end;
  161.   end;
  162. DIDC_call_tsr  := DTI_TIMEOUT;
  163. end;
  164.  
  165. (************************************************************************)
  166.  
  167. function hexval(c : char) : integer;
  168. begin
  169.   case upcase(c) of
  170.   '0' : hexval  := 0;
  171.   '1' : hexval  := 1;
  172.   '2' : hexval  := 2;
  173.   '3' : hexval  := 3;
  174.   '4' : hexval  := 4;
  175.   '5' : hexval  := 5;
  176.   '6' : hexval  := 6;
  177.   '7' : hexval  := 7;
  178.   '8' : hexval  := 8;
  179.   '9' : hexval  := 9;
  180.   'A' : hexval  := 10;
  181.   'B' : hexval  := 11;
  182.   'C' : hexval  := 12;
  183.   'D' : hexval  := 13;
  184.   'E' : hexval  := 14;
  185.   'F' : hexval  := 15;
  186.   end;
  187. end;
  188.  
  189. (************************************************************************)
  190.  
  191. function hexconv(s : string) : integer;
  192. begin
  193. hexconv  := hexval(s[1])*16 + hexval(s[2]);
  194. end;
  195.  
  196. (************************************************************************)
  197.  
  198. function DIDC_locate_tsr : boolean;
  199. type
  200.   addr  = array[1..2] of word;
  201.   aa_type = array[1..20] of char;
  202. var
  203.   a : ^addr;
  204.   s,o : word;
  205.   aa : ^aa_type;
  206.   i,j : integer;
  207. begin
  208.  
  209. for j  := $60 to $67 do
  210.   begin
  211.   {writeln(j);}
  212.   a  := ptr(0,j*4);
  213.   s  := a^[2];
  214.   o  := a^[1];
  215.   {writeln('s = ',s,' o = ',o);}
  216.  
  217.   if (s > 0) then
  218.   for i  := 1 to 5 do
  219.     begin
  220.     aa  := ptr(s,o);
  221.     if (aa^[1] = 'P') and
  222.        (aa^[2] = 'Q') and
  223.        (aa^[3] = 'R') and
  224.        (aa^[4] = 'S') and
  225.        (aa^[5] = 'T') and
  226.        (aa^[6] = 'U') then
  227.       begin
  228.       DTIregs.ax  := 0;
  229.       Intr(j,DTIregs);
  230.       {
  231.       writeln(DTIregs.cx,'  ',DTIregs.dx);
  232.       readln;
  233.       }
  234.       params  := ptr(DTIregs.cx,DTIregs.dx);
  235.       DIDC_locate_tsr  := true;
  236.       DTIint  := j;
  237.       exit;
  238.       end;
  239.     o  := o + 1;
  240.     end;
  241.   end;
  242. DIDC_locate_tsr  := false;
  243. DTIint  := 0;
  244. end;
  245.  
  246. (************************************************************************)
  247. (* General functions                                                    *)
  248. (************************************************************************)
  249.  
  250. function DIDC_total_pages(var dbname : string;
  251.                           var kname : string) : integer;
  252. begin
  253. (* function 001 *)
  254. strng  := '1 '+dbname+' '+kname;
  255. DIDC_total_pages  := DIDC_call_tsr(strng);
  256. end;
  257.  
  258. (************************************************************************)
  259.  
  260. function DIDC_total_pages_type(var dbname : string;
  261.                                var kname : string;
  262.                                doc_type : integer) : integer;
  263. var
  264.   s : string[20];
  265. begin
  266. (* function 002 *)
  267. str(doc_type,s);
  268.  
  269. strng  := '2 '+dbname+' '+kname+' '+s;
  270. DIDC_total_pages_type  := DIDC_call_tsr(strng);
  271. end;
  272.  
  273. (************************************************************************)
  274.  
  275. function DIDC_call_menu(var dbname : string;
  276.                         var kname : string;
  277.                         flag : integer;
  278.                         var DocListFname : string) : Integer;
  279. var
  280.   s : string[20];
  281. Begin
  282. (* function 003 *)
  283.  
  284. (*
  285. if (length(dbname) = 0) then
  286.   begin
  287.  
  288.   DIDC_call_menu := NO_DB_NAME;
  289.   exit;
  290.   end;
  291.  
  292. if (length(kname) = 0) then
  293.   begin
  294.   DIDC_call_menu := EMPTY_KEY;
  295.   exit;
  296.   end;
  297.  *)
  298.  
  299. str(flag,s);
  300. strng  := '3 '+dbname+' '+kname+' '+s+' '+DocListFname;
  301. DIDC_call_menu  := DIDC_call_tsr(strng);
  302. End;
  303.  
  304. (************************************************************************)
  305.  
  306. function DIDC_tsr_type : integer;
  307. begin
  308. (* function 004 *)
  309. strng  := '4';
  310. DIDC_tsr_type  := DIDC_call_tsr(strng);
  311. end;
  312.  
  313. (************************************************************************)
  314.  
  315. function DIDC_batch_update :  integer;
  316. (* function 005 *)
  317. begin
  318. strng  := '5';
  319. DIDC_batch_update  := DIDC_call_tsr(strng);
  320. end;
  321.  
  322. (************************************************************************)
  323.  
  324. function DIDC_set_write_vol(wv : word) : integer;
  325. (* function 006 *)
  326. var
  327.   s : string[30];
  328. begin
  329. str(wv,s);
  330. strng  := '6 '+s;
  331. write_params(strng);
  332. DIDC_set_write_vol := DIDC_call_tsr(strng);
  333. end;
  334.  
  335. (************************************************************************)
  336.  
  337. function DIDC_clear_doc_page : integer;
  338. (* function 007 *)
  339. begin
  340. strng  := '7';
  341. DIDC_clear_doc_page  := DIDC_call_tsr(strng);
  342. end;
  343.  
  344. (************************************************************************)
  345.  
  346. function DIDC_unique_key(var dbfname : string;
  347.                          var key : string;
  348.                          len : integer) : integer;
  349. (* function 008 *)
  350. var
  351.   i,j : integer;
  352.   c : char;
  353.   s : string[20];
  354. begin
  355. str(len,s);
  356. strng  := '8 '+dbfname+' '+s;
  357. i  := DIDC_Call_Tsr(strng);
  358.  
  359.  
  360. j  := 3;
  361. if (i = 0) then
  362.   begin
  363.   move(params^[j],c,1);
  364.   key  := '';
  365.   while (c > #0) do
  366.     begin
  367.     key  := key + c;
  368.     j  := j + 1;
  369.     move(params^[j],c,1);
  370.     end;
  371.   end;
  372.  
  373. DIDC_Unique_Key  := i;
  374. end;
  375.  
  376. (************************************************************************)
  377.  
  378. function DIDC_get_write_vol : integer;
  379. begin
  380. (* function 010 *)
  381. strng  := '10';
  382. DIDC_get_write_vol  := DIDC_call_tsr(strng);
  383. end;
  384.  
  385. (************************************************************************)
  386.  
  387. function DIDC_show_luns : integer;
  388. begin
  389. (* function 011 *)
  390. strng  := '11';
  391. DIDC_show_luns := DIDC_call_tsr(strng);
  392. end;
  393.  
  394. (************************************************************************)
  395. (* Scan functions                                                       *)
  396. (************************************************************************)
  397.  
  398. function DIDC_scan_page(var dbname : string;
  399.                         var kname : string;
  400.                         page_type : integer) : Integer;
  401. var
  402.  s : string[10];
  403. Begin
  404. str(page_type,s);
  405. strng  := '101 '+dbname+' '+kname+' '+s;
  406. DIDC_scan_page  := DIDC_call_tsr(strng);
  407. End;
  408.  
  409. (************************************************************************)
  410.  
  411. function DIDC_auto_scan(var dbname : string;
  412.                         var kname : string;
  413.                         page_type : integer) : Integer;
  414. var
  415.  s : string[10];
  416. Begin
  417. str(page_type,s);
  418. strng  := '102 '+dbname+' '+kname+' '+s;
  419. DIDC_auto_scan  := DIDC_call_tsr(strng);
  420. End;
  421.  
  422. (************************************************************************)
  423.  
  424. function DIDC_set_scanner(page_len : integer;
  425.                           source : integer;
  426.                           intensity : integer) : integer;
  427. var
  428.   s1,s2,s3 : string[20];
  429. begin
  430. (* function 103 *)
  431. str(page_len,s1);
  432. str(source,s2);
  433. str(intensity,s3);
  434. strng  := '103 '+s1+' '+s2+' '+s3;
  435. DIDC_set_scanner := DIDC_call_tsr(strng);
  436. end;
  437.  
  438. (************************************************************************)
  439.  
  440. function DIDC_insert_page(var dbname : string;
  441.                           var kname : string;
  442.                           page_type : integer;
  443.                           page_num  : integer) : Integer;
  444. var
  445.   s1,s2 : string[20];
  446. begin
  447. (* function 104 *)
  448. str(page_type,s1);
  449. str(page_num,s2);
  450. strng  := '104 '+dbname+' '+kname+' '+s1+' '+s2;
  451. DIDC_insert_page  := DIDC_call_tsr(strng);
  452. end;
  453.  
  454. (************************************************************************)
  455.  
  456. function DIDC_delete_page(var dbname : string;
  457.                           var kname : string;
  458.                           page_type : integer;
  459.                           page_num  : integer) : Integer;
  460. var
  461.   s1,s2 : string[20];
  462. begin
  463. (* function 105 *)
  464. str(page_type,s1);
  465. str(page_num,s2);
  466. strng  := '105 '+dbname+' '+kname+' '+s1+' '+s2;
  467. DIDC_delete_page  := DIDC_call_tsr(strng);
  468. end;
  469.  
  470. (************************************************************************)
  471.  
  472. function DIDC_get_scanner(param : integer) : Integer;
  473. var
  474.   s1 : string[20];
  475. begin
  476. (* function 106 *)
  477. str(param,s1);
  478. strng  := '106 '+s1;
  479. DIDC_get_scanner  := DIDC_call_tsr(strng);
  480. end;
  481.  
  482. (************************************************************************)
  483.  
  484. function DIDC_save_scan_set : Integer;
  485. begin
  486. (* function 107 *)
  487. strng  := '107';
  488. DIDC_save_scan_set  := DIDC_call_tsr(strng);
  489. end;
  490.  
  491.  
  492. (************************************************************************)
  493. (* Print functions                                                      *)
  494. (************************************************************************)
  495.  
  496. function DIDC_print_all_pages_type(var dbname : string;
  497.                                    var kname : string;
  498.                                    doctype : integer) : integer;
  499. var
  500.   s1 : string[20];
  501. begin
  502. (* function 201 *)
  503. str(doctype,s1);
  504.  
  505. strng  := '201 '+dbname+' '+kname+' '+s1;
  506. DIDC_print_all_pages_type  := DIDC_call_tsr(strng);
  507. end;
  508.  
  509. (************************************************************************)
  510.  
  511. function DIDC_print_pages(var dbname : string;
  512.                           var kname : string;
  513.                           doctype : integer;
  514.                           first_page : integer;
  515.                           last_page : integer) : integer;
  516. var
  517.   s1,s2,s3 : string[20];
  518. begin
  519. str(doctype,s1);
  520. str(first_page,s2);
  521. str(last_page,s3);
  522.  
  523. strng  := '203 '+dbname+' '+kname+' '+s1+' '+s2+' '+s3;
  524. DIDC_print_pages  := DIDC_call_tsr(strng);
  525. end;
  526.  
  527. (************************************************************************)
  528. (* Display Functions                                                    *)
  529. (************************************************************************)
  530.  
  531. function DIDC_display_page(var dbname : string;
  532.                            var kname : string;
  533.                            pagetype, page : integer;
  534.                            control : integer) : Integer;
  535. var
  536.   s1,s2,s3 : string[30];
  537. (* function 300 *)
  538. begin
  539. str(pagetype,s1);
  540. str(page,s2);
  541. str(control,s3);
  542.  
  543. strng  := '300 '+dbname+' '+kname+' '+s1+' '+s2+' '+s3;
  544. DIDC_display_page  := DIDC_call_tsr(strng);
  545. end;
  546.  
  547. (************************************************************************)
  548.  
  549. procedure checkkf9200;
  550. begin
  551. if not DIDC_locate_tsr then
  552.   begin
  553.   writeln('VISAGE is not loaded.');
  554.   writeln('You will not be able to access images...');
  555.   readln;
  556.   end;
  557. end;
  558.  
  559. (************************************************************************)
  560.  
  561. begin
  562. checkkf9200;
  563. end.
  564.  
  565.  
  566.