home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Source Code / Visual Basic Source Code.iso / vbsource / params / api_call.bas next >
Encoding:
BASIC Source File  |  1994-10-16  |  3.3 KB  |  120 lines
  1. Option Explicit
  2. '
  3. ' Common API Declarations and Functions
  4. '
  5.   '
  6.   '  OFSTRUCT Data Structure for OpenFile API Call
  7.   '
  8.     Type OFSTRUCT
  9.       cBytes As String * 1
  10.       fFixedDisk As String * 1
  11.       nErrCode As Integer
  12.       reserved As String * 4
  13.       szPathName As String * 128
  14.     End Type
  15.   '
  16.   ' API Declarations
  17.   '
  18.     '
  19.     ' Menu API Declarations
  20.     '
  21.       Declare Function GetSystemMenu Lib "User" (ByVal hWnd As Integer, ByVal bRevert As Integer) As Integer
  22.       Declare Function RemoveMenu Lib "User" (ByVal hMenu As Integer, ByVal nPosition As Integer, ByVal wFlags As Integer) As Integer
  23.     '
  24.     ' OpenFile API Call
  25.     '
  26.       Declare Function OpenFile Lib "Kernel" (ByVal lpFileName As String, lpReOpenBuff As OFSTRUCT, ByVal wStyle As Integer) As Integer
  27.   '
  28.   ' API Constants
  29.   '
  30.     '
  31.     ' Menu Constants
  32.     '
  33.       Const MF_BYPOSITION = &H400
  34.     '
  35.     ' OpenFile Constants
  36.     '
  37.       Const OF_EXIST = &H4000
  38.       Const OF_READ = &H0
  39.       Const OF_SHARE_COMPAT = &H0
  40.   '
  41.   ' Global API Related Constants
  42.   '
  43.       '
  44.       ' IsFile() Routine
  45.       '
  46.         Global Const ISFILE_API = 0
  47.         Global Const ISFILE_DIR = 1
  48.   '
  49.   ' Module Level Variables
  50.   '
  51.     Dim r As Variant      ' API Function Throwaway Return Value
  52.  
  53. Function IsFile (sFileName As String, Method As Integer) As Integer
  54.   '
  55.   ' True  = File Exists
  56.   ' False = File does not exist
  57.   '
  58.   ' method = ISFILE_API = 0 = Use OpenFile API call
  59.   ' method = ISFILE_DIR = 1 = Use DIR$ method
  60.   '
  61.   Dim iResult As Integer
  62.   Dim Response As OFSTRUCT
  63.   Dim sResult As String
  64.   On Error GoTo IsFile_Err
  65.   If Method = 0 Then
  66.     iResult = OpenFile(sFileName, Response, OF_EXIST + OF_READ + OF_SHARE_COMPAT)
  67.     If Response.nErrCode <> 0 Then
  68.       Select Case Response.nErrCode
  69.         Case &H2, &H3
  70.           '
  71.           ' Normal File doesn't exist errors, pass on thru
  72.           '
  73.         Case &H5
  74.           MsgBox "You do not have appropriate rights to " & sFileName & ".", MB_ICONEXCLAMATION
  75.         Case &H20, &H21
  76.           MsgBox sFileName & " is in use by another user or process.  You may need to attempt this process at a later time.", MB_ICONEXCLAMATION
  77.         Case &H35, &H36, &H39, &H3A, &H3B, &H3C, &H40, &H41, &H43, &H45, &H58
  78.           MsgBox "Network Error #" & Hex$(Response.nErrCode) & " occured in OpenFile API function!", MB_ICONEXCLAMATION
  79.         Case Else
  80.           MsgBox "DOS/Windows Error #" & Hex$(Response.nErrCode) & " occured in OpenFile API function!", MB_ICONEXCLAMATION
  81.       End Select
  82.       iResult = False
  83.     End If
  84.   Else
  85.     sResult = Dir$(sFileName, 0)
  86.     If sResult = "" Then
  87.       iResult = False
  88.     Else
  89.       iResult = True
  90.     End If
  91.   End If
  92.   IsFile = iResult
  93.   Exit Function
  94.  
  95. IsFile_Err:
  96.   sResult = ""
  97.   Resume Next
  98.  
  99. End Function
  100.  
  101. Sub SetDialogMenu (frm As Form)
  102.   '
  103.   ' Removes menu items from the System menu of the specified Form
  104.   ' to achieve a standard dialog look.
  105.   '
  106.   Dim hSysMenu As Integer
  107.   '
  108.   ' Obtain the handle to the forms System menu
  109.   '
  110.   hSysMenu = GetSystemMenu(frm.hWnd, 0)
  111.   '
  112.   ' Remove all but the MOVE and CLOSE options.  The menu items
  113.   ' must be removed starting with the last menu item.
  114.   '
  115.   r = RemoveMenu(hSysMenu, 8, MF_BYPOSITION)
  116.   r = RemoveMenu(hSysMenu, 7, MF_BYPOSITION)
  117.   r = RemoveMenu(hSysMenu, 5, MF_BYPOSITION)
  118. End Sub
  119.  
  120.