home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Source Code / Visual Basic Source Code.iso / vbsource / vidlibp / vidlib.bas < prev    next >
Encoding:
BASIC Source File  |  1995-05-08  |  11.8 KB  |  375 lines
  1. ' Subsystem: Main
  2. ' Module:    VidLib.Bas
  3. ' Date:      01/02/94
  4. ' Author:    Richard Stauch
  5. ' Notes:
  6. '
  7.  
  8. Option Explicit
  9. DefInt A-Z
  10.  
  11. ' Windows DLL functions.
  12. ' Get Windows directory.
  13. Declare Function GetWindowsDirectory Lib "Kernel" (ByVal lpBuffer As String, ByVal nSize As Integer) As Integer
  14.  
  15. ' Use Windows Help engine.
  16. 'Declare Function WinHelp Lib "User" (ByVal hwnd, ByVal lpzHelpFile, ByVal wCommand, ByVal dwData As Long)
  17. Declare Function WinHelp Lib "User" (ByVal hwnd, ByVal HelpFile$, ByVal wCommand, ByVal dwData As Long)
  18. '  Commands to pass WinHelp(wCmd)
  19. Global Const HELP_CONTEXT = &H1     ' Display topic identified by number in dwData
  20. Global Const HELP_QUIT = &H2        ' Terminate help
  21. Global Const HELP_INDEX = &H3       ' Display index
  22. Global Const HELP_HELPONHELP = &H4  ' Display help on using help
  23.  
  24. ' MousePointer
  25. Global Const DEFAULT = 0        ' 0 - Default
  26. Global Const HOURGLASS = 11     ' 11 - Hourglass
  27.  
  28. ' MsgBox parameters.
  29. ' Buttons
  30. Global Const MB_OK = 0                 ' OK button only
  31. Global Const MB_OKCANCEL = 1           ' OK and Cancel buttons
  32.  
  33. ' Icons
  34. Global Const MB_ICONSTOP = 16          ' Critical message
  35. Global Const MB_ICONQUESTION = 32      ' Warning query
  36. Global Const MB_ICONEXCLAMATION = 48   ' Warning message
  37. Global Const MB_ICONINFORMATION = 64   ' Information message
  38.  
  39. ' Return values
  40. Global Const IDCANCEL = 2              ' Cancel button pressed
  41.  
  42. 'Common Dialog Control
  43. 'Action Property
  44. Global Const DLG_FILE_OPEN = 1
  45.  
  46. 'File Open/Save Dialog Flags
  47. Global Const OFN_SHOWHELP = &H10&
  48. Global Const OFN_EXTENSIONDIFFERENT = &H400&
  49. Global Const OFN_FILEMUSTEXIST = &H1000&
  50. Global Const OFN_CREATEPROMPT = &H2000&
  51.  
  52. ' Data control constants.
  53. ' Field Data Types
  54. Global Const DB_INTEGER = 3
  55. Global Const DB_LONG = 4
  56. Global Const DB_TEXT = 10
  57. Global Const DB_MEMO = 12
  58.  
  59. ' CreateDatabase and CompactDatabase Language constants.
  60. Global Const DB_LANG_GENERAL = ";LANGID=0x0809;CP=1252;COUNTRY=0"
  61.  
  62. ' Validate event Action arguments
  63. Global Const DATA_ACTIONCANCEL = 0
  64. Global Const DATA_ACTIONMOVEFIRST = 1
  65. Global Const DATA_ACTIONMOVEPREVIOUS = 2
  66. Global Const DATA_ACTIONMOVENEXT = 3
  67. Global Const DATA_ACTIONMOVELAST = 4
  68. Global Const DATA_ACTIONUPDATE = 6
  69. Global Const DATA_ACTIONFIND = 8
  70. Global Const DATA_ACTIONCLOSE = 10
  71. Global Const DATA_ACTIONUNLOAD = 11
  72.  
  73.  ' The version number of this program.
  74. Global Const VERSION = "1.00"
  75.  
  76. ' Show method parameter
  77. Global Const MODAL = 1
  78.  
  79. ' Check Value
  80. Global Const UNCHECKED = 0 ' 0 - Unchecked
  81. Global Const CHECKED = 1   ' 1 - Checked
  82. Global Const GRAYED = 2    ' 2 - Grayed
  83.  
  84. ' Application specific Constants.
  85. ' OK Message box procedure
  86. Global Const MBC_BADDATA = 1
  87. Global Const MBC_BADFILE = 2
  88. Global Const MBC_CHECKFILE = 3
  89. Global Const MBC_COPYPROBLEM = 4
  90. Global Const MBC_CREATEPROBLEM = 5
  91. Global Const MBC_NOBLANKS = 6
  92. Global Const MBC_NOTABLES = 7
  93. Global Const MBC_CODEINUSE = 8
  94.  
  95. ' OK/Cancel message box procedure
  96. Global Const MBC_REPLACEDATA = 1
  97. Global Const MBC_REPAIRDATA = 2
  98.  
  99. ' Global varibles.
  100. ' Data
  101. Global Synopsis As String
  102.  
  103. ' Control
  104. Global CurrentRecordCode As String
  105. Global Generic As String * 1
  106.  
  107. Global ReplaceData As Integer
  108. Global GenreCopy As Integer
  109. Global RatingCopy As Integer
  110. Global VideoCopy As Integer
  111.  
  112. ' Defaults
  113. Global PathName As String
  114. Global CopyName As String
  115. Global TempName As String
  116. Global HelpName As String
  117.  
  118. Global DefaultPath As String
  119. Global DefaultName As String
  120. Global DefaultReport As String
  121. Global DefaultOutput As String
  122.  
  123. Global Const VIDLIB_MAIN = 1
  124. Global Const VIDLIB_AUTHOR = 10
  125. Global Const VIDLIB_SEARCH = 999
  126.  
  127. Function CheckFile (CheckStr As String) As Integer
  128. ' Check the existence of a file.
  129. Dim X As String ' To hold return string from Dir$().
  130.   X$ = Dir$(CheckStr$)
  131. ' String length will zero if it doesn't exist.
  132.   If Len(X$) > 0 Then
  133.   ' File exists.
  134.     CheckFile% = True
  135.   Else
  136.   ' File does not exist.
  137.     CheckFile% = False
  138.   End If
  139. End Function
  140.  
  141. Function CreateDataFile (FileStr As String) As Integer
  142. ' Create a new database file.
  143. Dim DB As Database
  144. ' Create 3 new tables.
  145. Dim T01 As New TableDef
  146. Dim T02 As New TableDef
  147. Dim T03 As New TableDef
  148. ' Create fields and indexes.
  149. Dim F01 As New Field, F02 As New Field ' Video Code and Name.
  150. Dim F03 As New Field, F04 As New Field ' Video Genre and Rating Codes.
  151. Dim F05 As New Field, F06 As New Field ' Video Chroma and Recording Codes.
  152. Dim F07 As New Field, F08 As New Field ' Video Release Year and Running Time Codes.
  153. Dim F09 As New Field                   ' Video Synopsis (Memo).
  154. Dim I01 As New Index, I02 As New Index ' Video Code and Name indexes.
  155. Dim I03 As New Index, I04 As New Index ' Genre Code and Rating Code indexes.
  156. Dim F10 As New Field, F11 As New Field ' Genre Code and Text.
  157. Dim F12 As New Field, F13 As New Field ' Rating Code and Text.
  158. Dim I05 As New Index, I06 As New Index ' Genre Code and Rating Code indexes.
  159.   On Error GoTo CreateError
  160.   Set DB = CreateDatabase(FileStr$, DB_LANG_GENERAL)
  161.   If DB Is Nothing Then GoTo CreateError
  162. ' Set up the table names.
  163.   T01.Name = "Video"
  164.   T02.Name = "Genre"
  165.   T03.Name = "Rating"
  166. ' Set up the fields for table 01 (Video).
  167.   F01.Name = "VidCode"
  168.   F01.Type = DB_TEXT: F01.Size = 20
  169.   T01.Fields.Append F01
  170.   F02.Name = "VidName"
  171.   F02.Type = DB_TEXT: F02.Size = 127
  172.   T01.Fields.Append F02
  173.   F03.Name = "GenCode"
  174.   F03.Type = DB_TEXT: F03.Size = 1
  175.   T01.Fields.Append F03
  176.   F04.Name = "RatCode"
  177.   F04.Type = DB_TEXT: F04.Size = 1
  178.   T01.Fields.Append F04
  179.   F05.Name = "RecCode"
  180.   F05.Type = DB_TEXT: F05.Size = 1
  181.   T01.Fields.Append F05
  182.   F06.Name = "CrmCode"
  183.   F06.Type = DB_TEXT: F06.Size = 1
  184.   T01.Fields.Append F06
  185.   F07.Name = "RlsYear"
  186.   F07.Type = DB_LONG
  187.   T01.Fields.Append F07
  188.   F08.Name = "RunTime"
  189.   F08.Type = DB_LONG
  190.   T01.Fields.Append F08
  191.   F09.Name = "SynText"
  192.   F09.Type = DB_MEMO
  193.   T01.Fields.Append F09
  194. ' Fields are complete. Now, set up the indexes.
  195.   I01.Name = "CdeIdx"
  196.   I01.Fields = "VidCode"
  197.   I01.Primary = False: I01.Unique = True
  198.   T01.Indexes.Append I01
  199.   I02.Name = "NamIdx"
  200.   I02.Fields = "VidName"
  201.   I02.Primary = True: I02.Unique = True
  202.   T01.Indexes.Append I02
  203.   I03.Name = "GenIdx"
  204.   I03.Fields = "GenCode"
  205.   I03.Primary = False: I03.Unique = False
  206.   T01.Indexes.Append I03
  207.   I04.Name = "RatIdx"
  208.   I04.Fields = "RatCode"
  209.   I04.Primary = False: I04.Unique = False
  210.   T01.Indexes.Append I04
  211. ' Table definition is complete. Add it to the Database Tabledefs object.
  212.   DB.TableDefs.Append T01
  213. ' Set up the Genre table.
  214.   F10.Name = "GenCode"
  215.   F10.Type = DB_TEXT
  216.   F10.Size = 1
  217.   T02.Fields.Append F10
  218.   F11.Name = "GenText"
  219.   F11.Type = DB_TEXT
  220.   F11.Size = 30
  221.   T02.Fields.Append F11
  222.   I05.Name = "GenIdx"
  223.   I05.Fields = "GenCode"
  224.   I05.Primary = True: I05.Unique = True
  225.   T02.Indexes.Append I05
  226.   DB.TableDefs.Append T02
  227. ' Set up the Rating table.
  228.   F12.Name = "RatCode"
  229.   F12.Type = DB_TEXT
  230.   F12.Size = 1
  231.   T03.Fields.Append F12
  232.   F13.Name = "RatText"
  233.   F13.Type = DB_TEXT
  234.   F13.Size = 30
  235.   T03.Fields.Append F13
  236.   I06.Name = "RatIdx"
  237.   I06.Fields = "RatCode"
  238.   I06.Primary = True: I06.Unique = True
  239.   T03.Indexes.Append I06
  240.   DB.TableDefs.Append T03
  241. ' Now, the new database is complete. Close it.
  242.   DB.Close
  243.   CreateDataFile% = True
  244.   Exit Function
  245.  
  246. CreateError:
  247.   GenericMsgBox (MBC_CREATEPROBLEM)
  248.   CreateDataFile% = False
  249.   Exit Function
  250. End Function
  251.  
  252. Function GenericCancelBox (BoxToShow As Integer) As Integer
  253. ' Generic OK/Cancel Message Box.
  254. Dim Msg As String       ' Message to display.
  255. Dim msgType As Integer  ' Icon and buttons to use.
  256. Dim msgTitle As String  ' Title of the message box.
  257. Dim response As Integer ' User response.
  258.   Select Case BoxToShow%
  259.     Case MBC_REPLACEDATA
  260.     ' Replace data dialog.
  261.       msgTitle$ = "Replace Data"
  262.       msgType% = MB_OKCANCEL + MB_ICONQUESTION
  263.       Msg$ = "Are you sure you want to replace data?"
  264.     Case MBC_REPAIRDATA
  265.     ' Repair database dialog.
  266.       msgTitle$ = "Repair Database"
  267.       msgType% = MB_OKCANCEL + MB_ICONINFORMATION
  268.       Msg$ = "Ready to repair database " + PathName$ + "."
  269.       Msg$ = Msg$ + " Press OK to continue, or Cancel to abort."
  270.   End Select ' BoxToShow%
  271. ' Display the box and get the user's response.
  272.   response% = MsgBox(Msg$, msgType%, msgTitle)
  273.   If response% = IDCANCEL Then
  274.   ' The user clicked Cancel.
  275.     GenericCancelBox% = True
  276.   Else
  277.   ' The user clicked OK.
  278.     GenericCancelBox% = False
  279.   End If
  280. End Function
  281.  
  282. Sub GenericMsgBox (BoxToShow As Integer)
  283. ' Generic Message Box.
  284. Dim Msg As String       ' Message to display.
  285. Dim msgType As Integer  ' Icon and buttons to use.
  286. Dim msgTitle As String  ' Title of the message box.
  287. Dim response As Integer ' User response.
  288.   Select Case BoxToShow%
  289.     Case MBC_BADDATA
  290.     ' Inform user there's bad data in one or more field(s).
  291.       msgTitle$ = "Update Error"
  292.       msgType% = MB_OK + MB_ICONEXCLAMATION
  293.       Msg$ = "There is bad data in some of the fields."
  294.       Msg$ = Msg$ & " Please, check for duplicate key"
  295.       Msg$ = Msg$ & " values, or invalid data, then"
  296.       Msg$ = Msg$ & " try the operation again."
  297.     Case MBC_BADFILE
  298.     ' Inform the user there's a problem with the file name.
  299.       msgTitle$ = "File Error"
  300.       msgType% = MB_OK + MB_ICONEXCLAMATION
  301.       Msg$ = "There is some problem with the"
  302.       Msg$ = Msg$ & " Drive:\Path\File name."
  303.       Msg$ = Msg$ & " Please, check it and try again."
  304.     Case MBC_COPYPROBLEM
  305.     ' Notify the user to select a different "To" file.
  306.       msgTitle$ = "Copy Error"
  307.       msgType% = MB_OK + MB_ICONEXCLAMATION
  308.       Msg$ = "You cannot copy a file onto itself!"
  309.     Case MBC_CREATEPROBLEM
  310.     ' Tell the user the system has a problem creating this file.
  311.       msgTitle$ = "Create Error"
  312.       msgType% = MB_OK + MB_ICONSTOP
  313.       Msg$ = "The system cannot create the"
  314.       Msg$ = Msg$ & " database in this directory."
  315.     Case MBC_NOBLANKS
  316.     ' The user has blanks in key fields.
  317.       msgTitle$ = "Update Error"
  318.       msgType% = MB_OK + MB_ICONEXCLAMATION
  319.       Msg$ = "There can be no blanks in key fields."
  320.     Case MBC_NOTABLES
  321.     ' The user has to select tables to copy.
  322.       msgTitle$ = "Copy Error"
  323.       msgType% = MB_OK + MB_ICONEXCLAMATION
  324.       Msg$ = "No tables have been selected!"
  325.       Msg$ = Msg$ & " Press the Options button,"
  326.       Msg$ = Msg$ & " and select one or more"
  327.       Msg$ = Msg$ & " table(s) to copy."
  328.     Case MBC_CODEINUSE
  329.     ' This code is in use.
  330.       msgTitle$ = "Delete Error"
  331.       msgType% = MB_OK + MB_ICONEXCLAMATION
  332.       Msg$ = "This code is in use in the Video Table."
  333.       Msg$ = Msg$ & " Change the Video Table records"
  334.       Msg$ = Msg$ & " that use this code, and try this"
  335.       Msg$ = Msg$ & " operation again."
  336.   End Select ' BoxToShow%
  337. ' Display the box and get the OK response.
  338.   response% = MsgBox(Msg$, msgType%, msgTitle)
  339. End Sub
  340.  
  341. Function SelectPath () As Integer
  342. ' Select a path and file name to use.
  343.   VidLib.dlgOpen.Filename = PathName$
  344.   VidLib.dlgOpen.InitDir = CurDir$
  345.   VidLib.dlgOpen.Flags = OFN_CREATEPROMPT Or OFN_EXTENSIONDIFFERENT Or OFN_SHOWHELP
  346.   ' Display the common dialog box.
  347.   On Error GoTo SelectError ' If user presses the Cancel button.
  348.   VidLib.dlgOpen.Action = DLG_FILE_OPEN
  349.   ' Retrieve the selected file path and name.
  350.   PathName$ = VidLib.dlgOpen.Filename
  351.   If Len(Dir$(PathName$)) > 0 Then
  352.   ' The file exists.
  353.     SelectPath% = True
  354.   Else
  355.   ' The file doesn't exist, so create it.
  356.     SelectPath% = CreateDataFile(PathName$)
  357.   End If
  358.   Exit Function
  359.  
  360. SelectError:
  361. ' Ignore Cancel button "error".
  362.   SelectPath% = False
  363.   Exit Function
  364. End Function
  365.  
  366. Function SetPathString (FileStr As String) As String
  367. ' Set the fully qualified file name.
  368.   If Right$(DefaultPath$, 1) = "\" Then
  369.     SetPathString$ = DefaultPath$ + FileStr$
  370.   Else
  371.     SetPathString$ = DefaultPath$ + "\" + FileStr$
  372.   End If
  373. End Function
  374.  
  375.