home *** CD-ROM | disk | FTP | other *** search
/ Windows Game Programming for Dummies (2nd Edition) / WinGamProgFD.iso / pc / DirectX SDK / DXSDK / samples / Multimedia / VBSamples / DirectShow / Editing / DexterVB / modGeneral.bas < prev    next >
Encoding:
BASIC Source File  |  2001-10-08  |  8.8 KB  |  198 lines
  1. Attribute VB_Name = "modGeneral"
  2. '*******************************************************************************
  3. '*       This is a part of the Microsoft DXSDK Code Samples.
  4. '*       Copyright (C) 1999-2001 Microsoft Corporation.
  5. '*       All rights reserved.
  6. '*       This source code is only intended as a supplement to
  7. '*       Microsoft Development Tools and/or SDK documentation.
  8. '*       See these sources for detailed information regarding the
  9. '*       Microsoft samples programs.
  10. '*******************************************************************************
  11. Option Explicit
  12. Option Base 0
  13. Option Compare Text
  14.  
  15.  
  16. ' **************************************************************************************************************************************
  17. ' * PRIVATE INTERFACE- CONSTANTS
  18. ' *
  19. ' *
  20.             Private Const MAX_PATH = 255
  21.             
  22.  
  23.  
  24. ' **************************************************************************************************************************************
  25. ' * PRIVATE INTERFACE- DATA STRUCTURES
  26. ' *
  27. ' *
  28.             Private Type GUID
  29.                Guid1 As Long
  30.                Guid2 As Long
  31.                Guid3 As Long
  32.                Guid4(0 To 7) As Byte
  33.             End Type
  34.  
  35.  
  36.  
  37. ' **************************************************************************************************************************************
  38. ' * PRIVATE INTERFACE- DECLARATIONS
  39. ' *
  40. ' *
  41.             Private Declare Function GetComputerName Lib "kernel32" Alias "GetComputerNameA" (ByVal lpBuffer As String, nSize As Long) As Long
  42.             Private Declare Function GetComputerNameW Lib "kernel32" (lpBuffer As Any, nSize As Long) As Long
  43.             Private Declare Function CoCreateGuid Lib "OLE32.DLL" (pGUID As GUID) As Long
  44.             Private Declare Function StringFromGUID2 Lib "OLE32.DLL" (pGUID As GUID, ByVal PointerToString As Long, ByVal MaxLength As Long) As Long
  45.  
  46.  
  47.  
  48. ' **************************************************************************************************************************************
  49. ' * PUBLIC INTERFACE- PROCEDURES
  50. ' *
  51. ' *
  52.             ' ******************************************************************************************************************************
  53.             ' * procedure name: Buffer_ParseEx
  54.             ' * procedure description:   Parse's a fixed length string buffer of all vbNullCharacters AND vbNullStrings.
  55.             ' *                                        Argument bstrBuffer evaluates to either an ANSII or Unicode BSTR string buffer.
  56.             ' *                                        (bstrBuffer is almost always the output from a windows api call which needs parsed)
  57.             ' *
  58.             ' ******************************************************************************************************************************
  59.             Public Function Buffer_ParseEx(bstrBuffer As String) As String
  60.             Dim iCount As Long, bstrChar As String, bstrReturn As String
  61.             On Local Error GoTo ErrLine
  62.             
  63.             For iCount = 1 To Len(bstrBuffer) 'set up a loop to remove the vbNullChar's from the buffer.
  64.                   bstrChar = Strings.Mid(bstrBuffer, iCount, 1)
  65.                   If bstrChar <> vbNullChar And bstrChar <> vbNullString Then bstrReturn = (bstrReturn + bstrChar)
  66.             Next
  67.             Buffer_ParseEx = bstrReturn
  68.             Exit Function
  69.             
  70. ErrLine:
  71.             Err.Clear
  72.             Exit Function
  73.             End Function
  74.             
  75.             
  76.             ' ******************************************************************************************************************************
  77.             ' * procedure name: System_GetComputerName
  78.             ' * procedure description:   Returns the name associated with the local system.
  79.             ' *
  80.             ' ******************************************************************************************************************************
  81.             Public Function System_GetComputerName() As String
  82.             Dim bstrBuffer As String * MAX_PATH, bstrReturn As String
  83.             On Local Error GoTo ErrLine
  84.             'obtain the computer name via the win32 api
  85.             GetComputerName bstrBuffer, Len(bstrBuffer) + 1
  86.             'assign the fixed length buffer to a variable length string
  87.             bstrReturn = bstrBuffer
  88.             'return the value to the client
  89.             System_GetComputerName = Buffer_ParseEx(bstrReturn)
  90.             Exit Function
  91.             
  92. ErrLine:
  93.             Err.Clear
  94.             Exit Function
  95.             End Function
  96.             
  97.             
  98.             
  99.             ' ******************************************************************************************************************************
  100.             ' * procedure name: ShowCommonDlgOpen
  101.             ' * procedure description:
  102.             ' *
  103.             ' ******************************************************************************************************************************
  104.             Public Function ShowCommonDlgOpen(Optional bstrCurrentDirectory As String, Optional bstrDefaultExtension As String, Optional bstrFilter As String) As String
  105.             Dim ctrl As Object
  106.             On Local Error GoTo ErrLine
  107.             
  108.             'instantiate control
  109.             If Not CreateObject("MSComDlg.CommonDialog.1") Is Nothing Then
  110.                Set ctrl = CreateObject("MSComDlg.CommonDialog.1")
  111.             ElseIf Not CreateObject("MSComDlg.CommonDialog") Is Nothing Then
  112.                Set ctrl = CreateObject("MSComDlg.CommonDialog")
  113.             End If
  114.             
  115.             If Not ctrl Is Nothing Then
  116.                'set properties
  117.                ctrl.Filter = bstrFilter
  118.                ctrl.DefaultExt = bstrDefaultExtension
  119.                ctrl.InitDir = bstrCurrentDirectory
  120.                ctrl.ShowOpen
  121.                'return to client
  122.                ShowCommonDlgOpen = ctrl.FileName
  123.             End If
  124.             
  125.             'clean-up & dereference
  126.             If Not ctrl Is Nothing Then Set ctrl = Nothing
  127.             Exit Function
  128.             
  129. ErrLine:
  130.  
  131.             Err.Clear
  132.             Exit Function
  133.             End Function
  134.             
  135.             
  136.             
  137.             ' ******************************************************************************************************************************
  138.             ' * procedure name: ShowCommonDlgSave
  139.             ' * procedure description:
  140.             ' *
  141.             ' ******************************************************************************************************************************
  142.             Public Function ShowCommonDlgSave(Optional bstrCurrentDirectory As String, Optional bstrDefaultExtension As String, Optional bstrFilter As String) As String
  143.             Dim ctrl As Object
  144.             On Local Error GoTo ErrLine
  145.             
  146.             'instantiate control
  147.             If Not CreateObject("MSComDlg.CommonDialog.1") Is Nothing Then
  148.                Set ctrl = CreateObject("MSComDlg.CommonDialog.1")
  149.             ElseIf Not CreateObject("MSComDlg.CommonDialog") Is Nothing Then
  150.                Set ctrl = CreateObject("MSComDlg.CommonDialog")
  151.             End If
  152.             
  153.             If Not ctrl Is Nothing Then
  154.                'set properties
  155.                ctrl.Filter = bstrFilter
  156.                ctrl.DefaultExt = bstrDefaultExtension
  157.                ctrl.InitDir = bstrCurrentDirectory
  158.                ctrl.ShowSave
  159.                'return to client
  160.                ShowCommonDlgSave = ctrl.FileName
  161.             End If
  162.             
  163.             'clean-up & dereference
  164.             If Not ctrl Is Nothing Then Set ctrl = Nothing
  165.             Exit Function
  166.             
  167. ErrLine:
  168.  
  169.             Err.Clear
  170.             Exit Function
  171.             End Function
  172.             
  173.             
  174.             
  175.             ' ******************************************************************************************************************************
  176.             ' * procedure name: GetGUID
  177.             ' * procedure description:  returns a random global unique identifier
  178.             ' *
  179.             ' ******************************************************************************************************************************
  180.             Public Function GetGUID() As String
  181.             Dim udtGUID As GUID, bstrGUID As String, nResultant As Long
  182.             On Local Error GoTo ErrLine
  183.             
  184.             nResultant = CoCreateGuid(udtGUID)
  185.             If nResultant Then
  186.                bstrGUID = vbNullString
  187.             Else
  188.                 bstrGUID = String$(38, 0)
  189.                 StringFromGUID2 udtGUID, StrPtr(bstrGUID), 39
  190.             End If
  191.             GetGUID = bstrGUID
  192.             Exit Function
  193.             
  194. ErrLine:
  195.             Err.Clear
  196.             Exit Function
  197.             End Function
  198.