home *** CD-ROM | disk | FTP | other *** search
/ PC Open 15 / PCOPEN15.ISO / Optix / DATA1.CAB / Script_Source / TbOcr.bas < prev   
Encoding:
BASIC Source File  |  1997-11-26  |  3.7 KB  |  111 lines
  1. Attribute VB_Name = "TbOcr"
  2. Option Explicit
  3.  
  4. Public Const timeouterr = -6
  5. Public Const ocrerr = -7
  6. Public Const registryerr = -8
  7.  
  8. Public Const TYPE_PIXD = &H44584950
  9. Public Const TYPE_TIFF = &H46464954
  10. Public Const TYPE_BMP = &H20504D42
  11. Public Const TYPE_RTF = &H20465452
  12. Public Const TYPE_file = &H656C6966
  13. Public Const CREATOR_PIXL = &H4C584950
  14.  
  15. Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
  16.  
  17. Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" _
  18.     (ByVal hwnd As Long, _
  19.     ByVal lpOperation As String, _
  20.     ByVal lpFile As String, _
  21.     ByVal lpParameters As String, _
  22.     ByVal lpDirectory As String, _
  23.     ByVal nShowCmd As Long) As Long
  24.  
  25.  
  26. Function TextBridgeOcr(infile As String, outfile As String) As Integer
  27.     
  28.     Dim keyname As String
  29.     
  30.     Dim retval As Long
  31.     Dim hKey1 As Long
  32.     Dim hKey2 As Long
  33.     Dim hKey3 As Long
  34.     
  35.     Dim version As Variant
  36.     Dim docpath As Variant
  37.     Dim terminate As Variant
  38.     Dim faceless As Variant
  39.     Dim format As Variant
  40.     
  41.     Dim starttime As Date
  42.     
  43.     keyname = "Software\Xerox\TextBridge"
  44.     
  45.     TextBridgeOcr = 0   ' no error to start with
  46.     
  47.         ' Get original registry values and set the values we need
  48.         
  49.         retval = RegOpenKeyEx(HKEY_CURRENT_USER, keyname, 0, KEY_ALL_ACCESS, hKey1)
  50.         If hKey1 = 0 Then
  51.             TextBridgeOcr = registryerr
  52.             Exit Function
  53.         End If
  54.         retval = QueryValueEx(hKey1, "CURRENTVERSION", version)
  55.         retval = RegOpenKeyEx(hKey1, version, 0, KEY_ALL_ACCESS, hKey2)
  56.         retval = RegOpenKeyEx(hKey2, "TextBridge", 0, KEY_ALL_ACCESS, hKey3)
  57.         retval = QueryValueEx(hKey3, "DefaultDocnamePath", docpath)
  58.         retval = QueryValueEx(hKey3, "TerminateAtEnd", terminate)
  59.         retval = QueryValueEx(hKey3, "Faceless", faceless)
  60.         retval = QueryValueEx(hKey3, "DefaultWpformat", format)
  61.         retval = SetValueEx(hKey3, "DefaultDocnamePath", REG_SZ, outfile)
  62.         retval = SetValueEx(hKey3, "TerminateAtEnd", REG_DWORD, 1)
  63.         retval = SetValueEx(hKey3, "Faceless", REG_DWORD, 1)
  64.         retval = SetValueEx(hKey3, "DefaultWpformat", REG_SZ, "Word 7.0 (*.rtf)")
  65.         
  66.         RegCloseKey (hKey3)
  67.         RegCloseKey (hKey2)
  68.         RegCloseKey (hKey1)
  69.  
  70.         '  Start TextBridge
  71.         
  72.         retval = ShellExecute(0, "open", "tb96.exe", infile, vbNullString, 1)
  73.         If retval <= 31 Then
  74.             TextBridgeOcr = ocrerr
  75.             GoTo restore
  76.         End If
  77.  
  78.         ' Wait for the OCR to be completed
  79.         
  80.         starttime = Time
  81.         
  82.         While (Dir(outfile) = "")
  83.             If DateDiff("n", starttime, Time) > 5 Then  ' 5 minute timeout
  84.                 TextBridgeOcr = timeouterr
  85.                 GoTo restore
  86.             End If
  87.             Call Sleep(200)
  88.         Wend
  89.          
  90.        ' Restore original registry values
  91. restore:
  92.         retval = RegOpenKeyEx(HKEY_CURRENT_USER, keyname, 0, KEY_ALL_ACCESS, hKey1)
  93.         If hKey1 = 0 Then
  94.             TextBridgeOcr = registryerr
  95.             Exit Function
  96.         End If
  97.         retval = QueryValueEx(hKey1, "CURRENT_VERSION", version)
  98.         retval = RegOpenKeyEx(hKey1, version, 0, KEY_ALL_ACCESS, hKey2)
  99.         retval = RegOpenKeyEx(hKey2, "TextBridge", 0, KEY_ALL_ACCESS, hKey3)
  100.         retval = SetValueEx(hKey3, "DefaultDocnamePath", REG_SZ, docpath)
  101.         retval = SetValueEx(hKey3, "TerminateAtEnd", REG_DWORD, terminate)
  102.         retval = SetValueEx(hKey3, "Faceless", REG_DWORD, faceless)
  103.         retval = SetValueEx(hKey3, "DefaultWpformat", REG_SZ, format)
  104.         RegCloseKey (hKey3)
  105.         RegCloseKey (hKey2)
  106.         RegCloseKey (hKey1)
  107.         
  108. End Function
  109.  
  110.  
  111.