Archive for the ‘VB6’ Category

  1. Hello, oo4o(VB6) World!

    Posted on 3月 5th, 2013 by cx20

    oo4o

    oo4o(Oracle Objects for OLE)は、COM ベースの Oracle Database 接続用 API である。
    Windows 環境で VB による開発に用いられることが多い。

    ソースコード(VB6 + oo4o + Oracle)

    Option Explicit
     
    Sub Main()
        Dim ses
        Dim db
        Dim rs
        Set ses = CreateObject("OracleInProcServer.XOraSession")
        Set db = ses.OpenDatabase( "ORCL", "scott/tiger", 0 )
        Set rs = db.CreateDynaset( "SELECT 'Hello, oo4o World!' AS Message FROM DUAL", 4)
        While NOT rs.EOF
            Debug.Print rs(0).Name
            Debug.Print "------------------"
            Debug.Print rs(0).Value
            rs.MoveNext
       Wend
    End Sub

    コンパイル方法

    C:¥> vb6 /make hello.vbp

    実行結果

    MESSAGE
    ------------------
    Hello, oo4o World!
  2. Hello, ADO(VB6) World!

    Posted on 3月 4th, 2013 by cx20

    ADO(VB6)

    ADO(ActiveX Data Objects)は、マイクロソフト社が開発した COM ベースの DBMS 接続用 API である。
    OLE DB プロバイダを介することで様々な DBMS への接続が可能となっている。
    OLE DB プロバイダとしては、以下のようなプロバイダがある。いくつかが OS 標準で付属している他、追加インストールが可能である。

    プロバイダ名 表示名 説明
    MSDASQL Microsoft OLE DB Provider for ODBC ODBC データベース
    Microsoft.Jet.OLEDB.4.0 Microsoft OLE DB Provider for Microsoft Jet Microsoft Jet データベース
    Microsoft.ACE.OLEDB.12.0 Microsoft Office 12.0 Access Database Engine OLE DB Provider Microsoft Access データベース
    SQLOLEDB Microsoft OLE DB Provider for SQL Server Microsoft SQL Server
    SQLNCLI10 SQL Server Native Client 10.0 Microsoft SQL Server
    MSDAORA Microsoft OLE DB Provider for Oracle Oracle データベース

    ソースコード(VB6 + ADO + OLEDB + Jet データベース)

    Option Explicit
     
    Sub Main()
        Dim cn
        Dim rs
     
        Set cn = CreateObject("ADODB.Connection")
        cn.Open "PROVIDER=Microsoft.Jet.OLEDB.4.0;Data Source=.hello.mdb"
        Set rs = cn.Execute("SELECT 'Hello, ADO World!' AS Message")
     
        While Not rs.EOF
            Debug.Print rs(0).Name
            Debug.Print "-------------------"
            Debug.Print rs(0).Value
            rs.MoveNext
        Wend
     
        rs.Close
        cn.Close
    End Sub

    ソースコード(VB6 + ADO + OLEDB + ACE データベース)

    Option Explicit
     
    Sub Main()
        Dim cn
        Dim rs
     
        Set cn = CreateObject("ADODB.Connection")
        cn.Open "PROVIDER=Microsoft.ACE.OLEDB.12.0;Data Source=.hello.accdb"
        Set rs = cn.Execute("SELECT 'Hello, ADO World!' AS Message")
     
        While Not rs.EOF
            Debug.Print rs(0).Name
            Debug.Print "-------------------"
            Debug.Print rs(0).Value
            rs.MoveNext
        Wend
     
        rs.Close
        cn.Close
    End Sub

    ソースコード(VB6 + ADO + OLEDB + SQL Server)

    Option Explicit
     
    Sub Main()
        Dim cn
        Dim rs
     
        Set cn = CreateObject("ADODB.Connection")
        cn.Open "PROVIDER=SQLOLEDB;" & _
             "SERVER=(local);DATABASE=master;", _
             "sa", "P@ssW0rd"
        Set rs = cn.Execute("SELECT 'Hello, ADO World!' AS Message")
     
        While Not rs.EOF
            Debug.Print rs(0).Name
            Debug.Print "-------------------"
            Debug.Print rs(0).Value
            rs.MoveNext
        Wend
     
        rs.Close
        cn.Close
    End Sub

    ソースコード(VB6 + ADO + OLEDB + Oracle)

    Option Explicit
     
    Sub Main()
        Dim cn
        Dim rs
     
        Set cn = CreateObject("ADODB.Connection")
        cn.Open "PROVIDER=MSDAORA;Data Source=ORCL", "scott", "tiger"
        Set rs = cn.Execute("SELECT 'Hello, ADO World!' AS Message FROM DUAL")
     
        While Not rs.EOF
            Debug.Print rs(0).Name
            Debug.Print "-------------------"
            Debug.Print rs(0).Value
            rs.MoveNext
        Wend
     
        rs.Close
        cn.Close
    End Sub

    ソースコード(VB6 + ADO + ODBC + SQL Server)

    Option Explicit
     
    Sub Main()
        Dim cn
        Dim rs
     
        Set cn = CreateObject("ADODB.Connection")
        cn.Open "PROVIDER=MSDASQL;Driver={SQL Server};" & _
            "SERVER=(local);DATABASE=master;", _
            "sa", "P@ssW0rd"
        Set rs = cn.Execute("SELECT 'Hello, ADO World!' AS Message")
     
        While Not rs.EOF
            Debug.Print rs(0).Name
            Debug.Print "-------------------"
            Debug.Print rs(0).Value
            rs.MoveNext
        Wend
     
        rs.Close
        cn.Close
    End Sub

    ソースコード(VB6 + ADO + ODBC + Oracle)

    Option Explicit
     
    Sub Main()
        Dim cn
        Dim rs
     
        Set cn = CreateObject("ADODB.Connection")
        cn.Open "PROVIDER=MSDASQL;Driver={Microsoft ODBC for Oracle};Server=ORCL", _
            "scott", "tiger"
        Set rs = cn.Execute("SELECT 'Hello, ADO World!' AS Message FROM DUAL")
     
        While Not rs.EOF
            Debug.Print rs(0).Name
            Debug.Print "-------------------"
            Debug.Print rs(0).Value
            rs.MoveNext
        Wend
     
        rs.Close
        cn.Close
    End Sub

    ソースコード(VB6 + ADO + ODBC + MySQL)

    Option Explicit
     
    Sub Main()
        Dim cn
        Dim rs
     
        Set cn = CreateObject("ADODB.Connection")
        cn.Open "PROVIDER=MSDASQL;Driver={MySQL ODBC 5.1 Driver};Server=localhost", _
            "root", "P@ssW0rd"
        Set rs = cn.Execute("SELECT 'Hello, ADO World!' AS Message")
     
        While Not rs.EOF
            Debug.Print rs(0).Name
            Debug.Print "-------------------"
            Debug.Print rs(0).Value
            rs.MoveNext
        Wend
     
        rs.Close
        cn.Close
    End Sub

    コンパイル方法

    C:¥> vb6 /make hello.vbp

    実行結果

    Message
    -----------------
    Hello, ADO World!
  3. Hello, DAO(VB6) World!

    Posted on 3月 3rd, 2013 by cx20

    DAO

    DAO(Data Access Object)は、マイクロソフト社が開発した COM ベースの DBMS 接続用 API である。
    主に Jet データベース(Access MDB)との接続に用いられるが、ODBC 経由で他の DBMS への接続も可能である。
    DAO 12 より 64bit 版が提供されるようになったが VB6 では 32bit 版のみ利用可能となっている。

    クライアントアプリケーション データベースエンジン 推奨されるデータベース形式
    Access 2.0 Jet 2.0 *.mdb (Jet 2.0)
    Access 95 Jet 3.0 *.mdb (Jet 3.x)
    Access 97 Jet 3.5 *.mdb (Jet 3.x)
    Access 2000 Jet 4.0 *.mdb (Jet 4.x)
    Access 2002 Jet 4.0 *.mdb (Jet 4.x)
    Access 2003 Jet 4.0 *.mdb (Jet 4.x)
    Access 2007 ACE 12.0 (32bit) *.accdb (ACE 12.0)
    Access 2010 (32bit) ACE 12.0 (32bit) *.accdb (ACE 12.0)
    DAO 3.0 Jet 3.0 *.mdb (Jet 3.x)
    DAO 3.5 Jet 3.5 *.mdb (Jet 3.x)
    DA0 3.6 Jet 4.0 *.mdb (Jet 4.x)
    DA0 12 (32bit) ACE 12.0 (32bit) *.accdb (ACE 12.0)
    Microsoft.Jet.OLEDB.3.51 Jet 3.5 *.mdb (Jet 3.x)
    Microsoft.Jet.OLEDB.4.0 Jet 4.0 *.mdb (Jet 4.x)
    Microsoft.ACE.OLEDB.12.0 (32bit) ACE 12.0 (32bit) *.accdb (ACE 12.0)

    ソースコード(VB6 + DAO + Jet データベース)

    Option Explicit
     
    Sub Main()
        Dim dbe
        Dim db
        Dim rs
     
        Set dbe = CreateObject("DAO.DBEngine.36")
        Set db = dbe.OpenDatabase("Hello.mdb")
        Set rs = db.OpenRecordset("SELECT 'Hello, DAO World!' AS Message")
     
        While Not rs.EOF
            Debug.Print rs(0).Name
            Debug.Print "-----------------"
            Debug.Print rs(0).Value
            rs.MoveNext
        Wend
     
        rs.Close
        db.Close
    End Sub

    ソースコード(VB6 + DAO + ACE データベース)

    Option Explicit
     
    Sub Main()
        Dim dbe
        Dim db
        Dim rs
     
        Set dbe = CreateObject("DAO.DBEngine.120")
        Set db = dbe.OpenDatabase("Hello.accdb")
        Set rs = db.OpenRecordset("SELECT 'Hello, DAO World!' AS Message")
     
        While Not rs.EOF
            Debug.Print rs(0).Name
            Debug.Print "-----------------"
            Debug.Print rs(0).Value
            rs.MoveNext
        Wend
     
        rs.Close
        db.Close
    End Sub

    ソースコード(VB6 + DAO + ODBC + SQL Server)

    Option Explicit
     
    Sub Main()
        Dim dbe
        Dim db
        Dim rs
     
        Set dbe = CreateObject("DAO.DBEngine.36")
        Set db = dbe.OpenDatabase("", False, False, _
            "ODBC;Driver={SQL Server};" & _
            "SERVER=(local);DATABASE=master;" & _
            "UID=sa;PWD=P@ssW0rd;")
        Set rs = db.OpenRecordset("SELECT 'Hello, DAO World!' AS Message")
     
        While Not rs.EOF
            Debug.Print rs(0).Name
            Debug.Print "-----------------"
            Debug.Print rs(0).Value
            rs.MoveNext
        Wend
     
        rs.Close
        db.Close
    End Sub

    ソースコード(VB6 + DAO + ODBC + Oracle)

    Option Explicit
     
    Const dbOpenSnapshot = 4
    Const dbSQLPassThrough = 64
     
    Sub Main()
        Dim dbe
        Dim db
        Dim rs
     
        Set dbe = CreateObject("DAO.DBEngine.36")
        Set db = dbe.OpenDatabase("", False, False, _
            "ODBC;Driver={Oracle in OraDb11g_home1};" & _
            "DBQ=ORCL;" & _
            "UID=scott;PWD=tiger;")
        Set rs = db.OpenRecordset("SELECT 'Hello, DAO World!' AS Message")
        ' パススルークエリの例(データベース側に依存する SQL を実行する場合)
        'Set rs = db.OpenRecordset("SELECT 'Hello, DAO World!' AS Message FROM DUAL", dbOpenSnapshot, dbSQLPassThrough)
     
        While Not rs.EOF
            Debug.Print rs(0).Name
            Debug.Print "-----------------"
            Debug.Print rs(0).Value
            rs.MoveNext
        Wend
     
        rs.Close
        db.Close
    End Sub

    コンパイル方法

    C:¥> vb6 /make hello.vbp

    実行結果

    Message
    -----------------
    Hello, DAO World!
  4. Hello, Win32 GUI(VB6) World!

    Posted on 7月 7th, 2012 by cx20

    Win32 GUI(VB6)

    Win32 アプリケーションは Windows 標準 API である Win32 API を使用した Windows アプリケーションである。
    以下は VB6 において Win32 API を使用した GUI アプリケーション の例となっている。

    ソースコード

    Private Const WS_OVERLAPPED As Long = &H0
    Private Const WS_MAXIMIZEBOX As Long = &H10000
    Private Const WS_MINIMIZEBOX As Long = &H20000
    Private Const WS_THICKFRAME As Long = &H40000
    Private Const WS_SYSMENU As Long = &H80000
    Private Const WS_CAPTION As Long = &HC00000
    Private Const WS_EX_APPWINDOW As Long = &H40000
    Private Const WS_OVERLAPPEDWINDOW As Long = (WS_OVERLAPPED Or WS_CAPTION Or WS_SYSMENU Or WS_THICKFRAME Or WS_MINIMIZEBOX Or WS_MAXIMIZEBOX)
     
    Private Const CS_VREDRAW As Long = &H1
    Private Const CS_HREDRAW As Long = &H2
     
    Private Const IDI_APPLICATION As Long = 32512
    Private Const IDC_ARROW As Long = 32512
     
    Private Const COLOR_WINDOW As Long = 5
    Private Const COLOR_BTNFACE As Long = 15
     
    Private Const WHITE_BRUSH As Long = 0
     
    Private Const CW_USEDEFAULT As Long = &H80000000
     
    Private Const SW_SHOWNORMAL As Long = 1
    Private Const SW_SHOW As Long = 5
    Private Const SW_SHOWDEFAULT As Long = 10
     
    Private Const WM_DESTROY As Long = &H2
    Private Const WM_PAINT As Long = &HF
     
    Private Const CLASS_NAME As String = "helloWindow"
    Private Const WINDOW_NAME As String = "Hello, World!"
     
    Private Type POINTAPI
        x As Long
        y As Long
    End Type
     
    Private Type MSG
        hwnd As Long
        message As Long
        wParam As Long
        lParam As Long
        time As Long
        pt As POINTAPI
    End Type
     
    Private Type WNDCLASSEX
        cbSize As Long
        style As Long
        lpfnWndProc As Long
        cbClsExtra As Long
        cbWndExtra As Long
        hInstance As Long
        hIcon As Long
        hCursor As Long
        hbrBackground As Long
        lpszMenuName As String
        lpszClassName As String
        hIconSm As Long
    End Type
     
    Type RECT
        Left As Long
        Top As Long
        Right As Long
        Bottom As Long
    End Type
     
    Type PAINTSTRUCT
        hdc As Long
        fErase As Long
        rcPaint As RECT
        fRestore As Long
        fIncUpdate As Long
        rgbReserved As Byte
    End Type
     
    Private Declare Function GetModuleHandle Lib "kernel32" Alias "GetModuleHandleA" (ByVal lpModuleName As Long) As Long
    Private Declare Function LoadIcon Lib "user32" Alias "LoadIconA" (ByVal hInstance As Long, ByVal lpIconName As Long) As Long
    Private Declare Function LoadCursor Lib "user32" Alias "LoadCursorA" (ByVal hInstance As Long, ByVal lpCursorName As Long) As Long
    Private Declare Function GetStockObject Lib "gdi32" (ByVal fnObject As Long) As Long
    Private Declare Function RegisterClassEx Lib "user32" Alias "RegisterClassExA" (lpwcx As WNDCLASSEX) As Long
    Private Declare Function CreateWindowEx Lib "user32" Alias "CreateWindowExA" (ByVal dwExStyle As Long, ByVal lpClassName As String, ByVal lpWindowName As String, ByVal dwStyle As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hWndParent As Long, ByVal hMenu As Long, ByVal hInstance As Long, lpParam As Any) As Long
    Private Declare Function ShowWindow Lib "user32" (ByVal hwnd As Long, ByVal nCmdShow As Long) As Long
    Private Declare Function UpdateWindow Lib "user32" (ByVal lhwnd As Long) As Long
    Private Declare Function GetMessage Lib "user32" Alias "GetMessageA" (lpMsg As MSG, ByVal hwnd As Long, ByVal wMsgFilterMin As Long, ByVal wMsgFilterMax As Long) As Long
    Private Declare Function TranslateMessage Lib "user32" (lpMsg As MSG) As Long
    Private Declare Function DispatchMessage Lib "user32" Alias "DispatchMessageA" (lpMsg As MSG) As Long
    Private Declare Sub PostQuitMessage Lib "user32" (ByVal nExitCode As Long)
    Private Declare Function DefWindowProc Lib "user32" Alias "DefWindowProcA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
    Private Declare Function BeginPaint Lib "user32" (ByVal hwnd As Long, lpPaint As PAINTSTRUCT) As Long
    Private Declare Function EndPaint Lib "user32" (ByVal hwnd As Long, lpPaint As PAINTSTRUCT) As Long
    Private Declare Function TextOut Lib "gdi32" Alias "TextOutA" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, ByVal lpString As String, ByVal nCount As Long) As Long
     
    Private Function FuncPtr(ByVal p As Long) As Long
        FuncPtr = p
    End Function
     
    Private Function WindowProc(ByVal hwnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
        Dim ps As PAINTSTRUCT
        Dim hdc As Long
        Dim strMessage As String
        strMessage = "Hello, Win32 GUI(VB6) World!"
     
        Select Case uMsg
        Case WM_PAINT
            hdc = BeginPaint(hwnd, ps)
            TextOut hdc, 0, 0, strMessage, Len(strMessage)
            EndPaint hwnd, ps
        Case WM_DESTROY
            Call PostQuitMessage(0)
        Case Else
            WindowProc = DefWindowProc(hwnd, uMsg, wParam, lParam)
            Exit Function
        End Select
        WindowProc = 0
    End Function
     
    Public Function WinMain() As Integer
        Dim wcex As WNDCLASSEX
        Dim hwnd As Long
        Dim message As MSG
        Dim pfnc As Long
        wcex.cbSize = Len(wcex)
        wcex.style = CS_HREDRAW Or CS_VREDRAW
        wcex.lpfnWndProc = FuncPtr(AddressOf WindowProc)
        wcex.cbClsExtra = 0
        wcex.cbWndExtra = 0
        wcex.hInstance = GetModuleHandle(0)
        wcex.hIcon = LoadIcon(0, IDI_APPLICATION)
        wcex.hCursor = LoadCursor(0, IDC_ARROW)
        wcex.hbrBackground = COLOR_WINDOW + 1
        wcex.lpszMenuName = vbNullString
        wcex.lpszClassName = CLASS_NAME
        wcex.hIconSm = LoadIcon(0, IDI_APPLICATION)
     
        Call RegisterClassEx(wcex)
     
        hwnd = CreateWindowEx( _
            0, _
            CLASS_NAME, _
            WINDOW_NAME, _
            WS_OVERLAPPEDWINDOW, _
            CW_USEDEFAULT, CW_USEDEFAULT, 640, 480, _
            0, 0, wcex.hInstance, 0)
     
        Call ShowWindow(hwnd, SW_SHOWDEFAULT)
        Call UpdateWindow(hwnd)
     
        Do While (GetMessage(message, 0, 0, 0))
            Call TranslateMessage(message)
            Call DispatchMessage(message)
        Loop
     
        WinMain = message.wParam
    End Function
     
    Public Sub Main()
        Call WinMain
    End Sub

    コンパイル方法

    C:¥> vb6 /make hello.vbp

    実行結果

    +------------------------------------------+
    |Hello, World!                    [_][~][X]|
    +------------------------------------------+
    |Hello, Win32 GUI(VB6) World!              |
    |                                          |
    |                                          |
    |                                          |
    |                                          |
    |                                          |
    |                                          |
    |                                          |
    |                                          |
    |                                          |
    +------------------------------------------+
  5. Hello, COM(VB6) World!

    Posted on 5月 13th, 2012 by cx20

    COM(VB6)

    COM(Component Object Model)はマイクロソフトの提唱するプログラム部品の仕様である。
    COM を用いて開発された部品であれば言語を問わず利用することができる。
    以下は VB6 による COM クライアント(事前バインディングならびに実行時バインディング)の例となっている。

    ソースコード(事前バインディング)

    Sub Main()
        Dim shell As New Shell32.shell
     
        Dim vRootFolder
        vRootFolder = Shell32.ShellSpecialFolderConstants.ssfWINDOWS
     
        Dim folder As Shell32.folder
        Set folder = shell.BrowseForFolder(0, "Hello, COM(VB6) World!", 0, vRootFolder)
     
        If Not folder Is Nothing Then
            Set folder = Nothing
        End If
        Set shell = Nothing
    End Sub

    以下、プロジェクトファイルより一部抜粋。

    プロジェクトファイル(事前バインディング)

    Type=Exe
    Reference=*G{00020430-0000-0000-C000-000000000046}#2.0#0#WINDOWSsystem32STDOLE2.TLB#OLE Automation
    Reference=*G{50A7E9B0-70EF-11D1-B75A-00A0C90564FE}#1.0#0#WINDOWSsystem32SHELL32.dll#Microsoft Shell Controls And Automation
    Module=Hello; Hello.bas
    Startup="Sub Main"
    ExeName32="hello.exe"
    Name="HelloProject"

    ソースコード(実行時バインディング)

    Sub Main()
        Dim shell
        Set shell = CreateObject("Shell.Application")
     
        Dim vRootFolder
        vRootFolder = 36 ' ssfWINDOWS
     
        Dim folder
        Set folder = shell.BrowseForFolder(0, "Hello, COM(VB6) World!", 0, vRootFolder)
     
        If Not folder Is Nothing Then
            Set folder = Nothing
        End If
        Set shell = Nothing
    End Sub

    コンパイル方法

    C:¥> vb6 /make Hello.vbp

    実行結果

    +----------------------------------------+
    |Browse For Folder                    [X]|
    +----------------------------------------+
    | Hello, COM(VB6) Wolrd!                 |
    |                                        |
    | +------------------------------------+ |
    | |[Windows]                           | |
    | | +[addins]                          | |
    | | +[AppCompat]                       | |
    | | +[AppPatch]                        | |
    | | +[assembly]                        | |
    | |     :                              | |
    | |     :                              | |
    | |     :                              | |
    | +------------------------------------+ |
    | [Make New Folder]    [  OK  ] [Cancel] |
    +----------------------------------------+
  6. Hello, Win32 API(VB6) World!

    Posted on 4月 18th, 2012 by cx20

    Win32 API(VB6)

    Win32 API は、Windows の機能にアクセスする為の API(Application Programming Interface)である。
    以下は VB6 からの呼出し例である。

    ソースコード

    Declare Function MessageBox Lib "User32.dll" Alias "MessageBoxA" ( _
        ByVal hWnd As Long, _
        ByVal lpText As String, _
        ByVal lpCaption As String, _
        ByVal uType As Long _
    ) As Integer
     
    Sub Main()
        MessageBox 0, "Hello, Win32 API(VB6) World!", "Hello, World!", vbOKOnly
    End Sub

    Win32 データ型と VB6 データ型の対応は主に以下のようになっている。

    Win32 データ型 C/C++ データ型 VB6
    HANDLE void * Long
    BYTE unsigned char Byte
    SHORT short Integer
    WORD unsigned short Integer
    INT int Long
    UINT unsigned int Long
    LONG long Long
    BOOL int Long
    DWORD unsigned long Long
    ULONG unsigned long Long
    CHAR char Byte
    WCHAR wchar_t Integer
    LPSTR char * String
    LPCSTR const char * String
    LPWSTR wchar_t * Long (StrPtr)
    LPCWSTR const wchar_t * Long (StrPtr)
    FLOAT float Single
    DOUBLE double Double

    コンパイル方法

    C:¥> vb6 /make hello.vbp

    実行結果

    ---------------------------
    Hello, World!
    ---------------------------
    Hello, Win32 API(VB6) World!
    ---------------------------
    OK   
    ---------------------------