Win32 API and DLLs

Win32 API

What cannot be executed in the specification of BASIC may be able to do when we use Win32 API.

Decimal BASIC for Win32 allows us to use Win32 APIs and DLLs that have the same calling convention as that of Win32 APIs.
We need the name of the API function and the name of the DLL that contains it. Arguments of the API function must be written in actual numbers but not in mnemonic.

We use string variables for processes that manipulate memories.
In particular, we must be careful in handling of APIs that require pointers as its parameters.

Note that mistake about using Win32 API can crash the system.


How to define a procedure that embeds an API function

We can define external or internal procedures except DEF statements using API functions.
For the function definition which uses an API function, an ASSIGN statement of the following format is written between the (EXTERNAL) FUNCTION line and the END FUNCTION line. The way to define a subprogram is similar.
ASSIGN "DLL_file_name", "function_name"

Example.

FUNCTION GetVersion
   ASSIGN "kernel32.dll","GetVersion"
END FUNCTION


"DLL_file_Name" is the file name of the DLL to which the API function belongs. "function_name" is the name of the API function registered in the DLL. Note that function_name is case sensitive. "DLL_file_name" and "function_name" are string constants, which do not contain variables, since the designated DLL is loaded on compiling.
Numerical arguments are evaluated as 32bit integers cutting off the upper bits. Numerical arguments are passed by value even if the procedure is a subprogram.
String arguments except null strings are passed as the 32bit pointers that point the first characters. In the DLL, strings in BASIC can be used as null-terminated strings. When a null string is assigned, a null pointer, which is not a pointer to a null string, shall be passed to the API function.

When a function is defined as numerical, the result becomes the value of the register EAX at the time when the control comes back. This value is evaluated as a 32bit signed integer.
When a function is defined as string type, the value of EAX register at the time when the control comes back is appreciated as a pointer to an ANSI (or ASCII) null-terminated string.

Example. 1

DECLARE EXTERNAL FUNCTION MesBox
LET n=MesBox(0,"Hello","BASIC",3)
PRINT n
END
EXTERNAL FUNCTION MesBox(owner,text$,caption$,flag)
ASSIGN  "user32.dll","MessageBoxA"
END FUNCTION 

Function values are always 32bit signed integers. When we want to appreciate them as unsigned, we apply MOD(x,2^32) functions.
When a Win32 API function is of result type BOOL, non-zero result means true.
If the result type of an API function is not numerical, this value has no meaning in BASIC but can be used as an argument for another API invoking.

Win32 API has two types of functions, one for ANSI strings, one for 16bit Unicode strings. As the internal character coding of Decimal BASIC is ANSI, so we use the one for ANSI, that is, of which the tail of the name is "A". (In the above example, we select MessageBoxA.)

Variable parameter

When we invoke an API function having a parameter that is a pointer to a variable or variables, we define a procedure as to have a string parameter.
Note. We can also directly manipulate the memory if we use a support DLL. ( → Direct memory access via MEMORY.DLL)
Declare OPTION CHARACTER BYTE if necessary to regard a string as a byte array.
When an argument is only used to pass a parameter to API and never be changed by API, string expression can be assigned as an argument.
When the API alters the argument to returns the result, pay attention to the following two.
Using REPEAT$-function or so, prepare a string variable of which length is suffice.
The value of this string variable must not be made by assignment of another variable, and must not have assigned to any other variable.

We draw the values received from the API using substring operations.
Example. 2

DECLARE EXTERNAL FUNCTION CurrDir$
PRINT CurrDir$
END
EXTERNAL FUNCTION CurrDir$
OPTION CHARACTER BYTE
FUNCTION GetCurrentDirectory(n,s$)
   ASSIGN "kernel32.dll","GetCurrentDirectoryA" 
END FUNCTION
LET s$=Repeat$(" ", 200)
LET n=GetCurrentDirectory(200,s$)
LET CurrDir$=s$(1:n)
END FUNCTION 

When we invoke an API having a parameter that becomes a pointer to an integer variable, we must define it to have a string parameter.
When we receive a value in a 32bit integer variable from an API, we allocate 4 bytes by executing LET s$=Repeat$("#", 4) and pass it to the API. When there are two or more variable parameters, we execute Repeat$-function for each variable.
On Intel x86 CPUs, Upper digits of a multi-byte integer are located at upper address. As characters are aligned in increasing order of address, a multi-byte integer is stored in a string from the lower byte.
Hence, when we appreciate as an unsigned 32bit integer, the result can be drawn applying ORD(s$(1:1)) + 2^8 * ORD(s$(2:2)) + 2^16 * ORD(s$(3:3)) + 2^24 * ORD(s$(4:4)) .
When we appreciate it as signed, subtract 2^32 from the result if it is not less than 2^31.

Struct

When an API has a struct itself as a parameter, we cut it into 4byte pieces and make them as parameters.
When an API has a parameter that is a pointer to a struct, we prepare a string variable of which value has required length.
We use the following external function to embed a 32bit integer onto a string variable.

EXTERNAL FUNCTION DWORD$(n)
OPTION CHARACTER byte
LET r=MOD(n,2^8) 
LET s$=CHR$(r) 
LET n=(n-r)/2^8 
LET r=MOD(n,2^8) 
LET s$=s$ & CHR$(r) 
LET n=(n-r)/2^8 
LET r=MOD(n,2^8) 
LET s$=s$ & CHR$(r) 
LET n=(n-r)/2^8 
LET r=MOD(n,2^8) 
LET DWORD$=s$ & CHR$(r) 
END FUNCTION

Decimal BASIC 7.4.8 or later has a supplied function DWORD$, of which the effect is the same as above.
When the struct is a batch of 32bit integers, we connect the results of this function.

We show an external function definition that draws an embedded 32bit signed integer from the string.
The parameter p indicates the position in bytes. The value for the first position is 0.

EXTERNAL FUNCTION int32(s$,p)
OPTION CHARACTER byte
LET n=0
FOR i=1 TO 4
   LET n=n+256^(i-1)*ORD(s$(p+i:p+i))
NEXT i
IF n<2^31 THEN LET int32=n ELSE LET int32=n-2^32
END FUNCTION


We use the following external function to embed a 16bit integer onto a string variable.

EXTERNAL FUNCTION WORD$(n)
OPTION CHARACTER byte
LET r=MOD(n,2^8) 
LET s$=CHR$(r) 
LET n=(n-r)/2^8 
LET r=MOD(n,2^8) 
LET WORD$=s$ & CHR$(r) 
END FUNCTION

Decimal BASIC 7.4.8 or later has a supplied function WORD$, of which the effect is the same as above.
When the struct is a batch of 16bit integers, we connect the results of this function.

We show an external function definition that draws an embedded 16bit signed integer from the string.
The parameter p indicates the position in byte. The value for the first position is 0.

EXTERNAL FUNCTION int16(s$,p)
OPTION CHARACTER byte
LET n=0
FOR i=1 TO 2
   LET n=n+256^(i-1)*ORD(s$(p+i:p+i))
NEXT i
IF n<2^15 THEN LET int16=n ELSE LET int16=n-2^16
END FUNCTION


Some WIN32 API function places a pointer on a struct.
We make a function that obtains the pointer to the first character the variable s$ using Win32 API CharPrev as follows.

EXTERNAL FUNCTION VarPtr(s$) 
FUNCTION CharPrev(s$,t$)
   ASSIGN "user32.dll","CharPrevA"
END FUNCTION
LET VarPtr=CharPrev(s$,s$)
END FUNCTION

Note. The real address of the string of a string variable is not unique to the variable, that is, that varies as to rewriting of the value.

Call back function

Some Win32 API function requires a call back function.

Decimal BASIC allows us to use up to 10 CallBack functions, which are identified by the numbers from 0 to 9.

Assignment of a CallBack function

We write a identification number at the tail of the FUNCTION or SUB line of the procedure that we use as a CallBack function in the following form. Identification numbers are from 0 to 9.
FUNCTION function_name(parameters),CALLBACK identification_number
SUB subprogram_name(parameters),CALLBACK identification_number


Arguments are always passed by value. A pointer to a null-terminated string can be an argument for a string parameter. Any other arguments should be assigned to numerical variables.
An argument of size bigger than 32 bit should be separated into 32bit pieces to be received by numerical variables. The byte size of the whole arguments including padding should be the number of parameters multiplied by 4.
Trueth (Boolean) values are received by numerical variables. Nonzero means true.

Address of a CallBack function
We use a CallBackAdr function to obtain the address of the CallBack function. The argument is the identification number of the CallBack function.

Example.

100 OPTION CHARACTER BYTE
110 LET Name$ = REPEAT$(CHR$(0),255
120 CALL EnumWindows(CallBackAdr(9), 0)
130 SUB EnumWindows(IpEnumFunc, IPalam)
140    ASSIGN "user32.dll","EnumWindows"
150 END SUB
160 FUNCTION GetWindowText(hWnd,IpString$,cch)
170    ASSIGN "user32.dll","GetWindowTextA"
180 END FUNCTION
190 FUNCTION Enum(Handle), CALLBACK 9
200    IF GetWindowText(Handle, Name$, LEN(Name$))<>0 THEN
210       PRINT NAME$(1:POS(NAME$,CHR$(0))-1)
220    END IF
230    LET Enum = -1
240 END FUNCTION
250 END


Notice.
Do not use CallBack functions asynchronously.

Mistakes on the number of parameters are never checked either on compiling or on executing. But it may damage the system.

Dynamical loading of DLLs

When we use a function that requires a function that is located in another DLL, it may need to be loaded beforehand.
In that case, we execute LoadLibrary with the DLL name as an argument, save the result, a handle of the DLL, in a numeric variable, and hand it and the name of the function to GetProcAddress to obtain the address of the function. if LoadLibray returns zero, it fails. When the DLL becomes needless, we invoke FreeLibrary with the handle of the DLL kept.

FUNCTION LoadLibrary(s$)
   ASSIGN "kernel32.dll","LoadLibraryA"
END FUNCTION
FUNCTION GetProcAddress(n,s$)
   ASSIGN "kernel32.dll","GetProcAddress"
END FUNCTION
SUB FreeLibrary(n)
   ASSIGN "kernel32.dll","FreeLibrary"
END SUB

Binary or Hexadecimal notation

We use supplied functions BVAL and BSTR$ to manipulate numbers written in the binary or hexadecimal notation.

BVAL(a$,2)     The non-negative integer whose binary representation is a$.
BVAL(a$,16)    The non-negative integer whose hexadecimal representation is a$.
BSTR$(n,2)     The binary representation of the non-negative integer n.
BSTR$(n,16)    The hexadecimal representation of the non-negative integer n.

Example. BSTR$(MOD(n, 2^32),16) Converts a 32bit signed integer to the unsigned hexadecimal representation.

Dangerousness

As the DLL has no information about the number of arguments, mistakes on the number of arguments cannot be checked either on compiling or on executing, whereas some goes as if they are right.
A shortage of the length of a string that is used as a variable argument may not obstruct the execution of the DLL function. But it destroys other variables, and then cause a problem later. This sort of mistake is difficult for us to find because the execution of the function may be seemingly normal.
If we indicate a numeric variable for the parameter that should be a pointer to an integer, the system reads the value as an address to alter the value of where of which address is it. This may cause an exception of extype -9900 if you are lucky, but this may cause no exception when the address is within the BASIC data area.


Use Win32 API information for Visual BASIC

Win 32 API information for Visual BASIC contains sufficient information for us to use in Decimal BASIC, whereas only a part of them can be used in Decimal BASIC.


WinAPI Database for VB Programmer
API別 Win32 サンプル集
Programming Library Visual BASIC
VBWin32API関数宣言モジュール
Visual Basic最新リンク2005
次は,VBで使うための解説ではないが,DLL名が明示されている。
Win32 API 関数リスト
以下は,C言語によるWin32 APIの解説。目的のAPIがどのDLLに含まれるかを,別途,調べる必要がある。
Win32 API入門

Function definitions

we define functions based on the information for Visual BASIC as follows.

Example.
Declare Function PolyBezierTo Lib "gdi32" ( ByVal hDC As Long, ByRef Points As POINT, ByVal PointNum As Long) As Long

FUCTION PolyBezierTo(hDC, Points$, PointNum)
   ASSIGN "gdi32.dll","PolyBezierTo"
END FUNCTION



Declare Function FindFirstFile Lib "kernel32" Alias "FindFirstFileA" ( ByVal FileName As String, ByRef FindData As WIN32_FIND_DATA) As Long

 
FUNCTION FindFirstFile(FileName$, FindData$)
   ASSIGN "kernel32.dll","FindFirstFileA"
END FUNCTION



Declare Function CloseHandle Lib "kernel32.dll" (ByVal hObject As Long) As Boolean

FUNCTION CloseHandle(hObject) 
   ASSIGN "kernel32.dll","CloseHandle"
END FUNCTION


In Visual BASIC, the DLL name is written following Lib. The DLL name is designated with the extension ".DLL" in Decimal BASIC.
The DLL function name is written following Alias in Visual BASIC. If Alias part is missing, the DLL function name coincides with the function Name.

We designate a numeric variable for a variable written as ByVal ・・・ As Long (or ByVal ・・・ As Integer, ByVal ・・・ As Byte).
We designate a string variable for a variable written as ByVal ・・・ As String.
We designate a string variable for a variable written as ByRef ・・・ As ・・・.
We designate a numeric or string variable for a variable written as ByVal ・・・ As Any depending on the usage. Tow or more function definitions are allowed to use the same DLL function if their names are different.
In case of ByVal ・・・ As String, in the Visual BASIC program, the variable may be used for receiving the results. In such case, the string must be uniquely generated.
Note. In Visual BASIC 6, Parameters designated with neither ByVal nor ByRef are assumed ByRef. And note that variables written punctuated by commas following ByVal are assumed ByVal.

Whatever the result type of the function is,functions are defined as numeric functions.
When the result type is Boolean, we appreciate non-zeros as true.
When the result type is String, we can not use the result as a string but we can use it as an argument for another function. In such case, the parameter should be declared as numeric.

Functions the result of which we do not use can be defined as a subprogram.
Example.

SUB CharUpper(s$)
   ASSIGN "user32.dll","CharUpperA"
END SUB


Memo. When CharUpper is defined as a numeric function, if we evaluate it with a string expression as the argument, the result of it points the working area where the string expression is evaluated, but as that area shall be released while the function works, that value shall lose the meaning when the execution of the function finishes.

User-defined types

In VB6, an integer type is that of a 16bit signed integer, long a 32bit signed integer.

Example.

Type POINTL
        x As Long
        y As Long
End Type

The type POINTL occupies 8 bytes.
When we embed a variable of type POINTL into a string variable s$, we concatenate s$ with DWORD$(x) & DWORD$(y).


Example.

Type POINTS
        x  As Integer
        y  As Integer
End Type

The type POINTS occupies 4 bytes.
When we embed a variable of type POINTS into a string variable s$, we concatenate s$ with WORD$(x) & WORD$(y).


example.

Type OUTPUT_DEBUG_STRING_INFO
        lpDebugStringData As String
        fUnicode As Integer
        nDebugStringLength As Integer
End Type

String type is a pointer to a string, and it occupies 4 byte.

Note.
Variables whose size is 4 bytes are put at the address that is a multiple of 4. Thus user defined type may have vain area. For example, when 4-byte variable follows a 1-byte variable, 3 byte padding is inserted.
Example.

Type ACE_HEADER
        AceType As Byte
        AceFlags As Byte
        AceSize As Long
End Type

The type ACE_HEADER occupies 8 bytes, there is a 2 byte padding between AceFlags and AceSize.

Numerical constants

In Visual BASIC, &H~~ means numerical constant in hexadecimal representation. "&" at the tail of a numeric constant means long type. This can be ignored.
Example. We rewrite &H1000 into BVAL("1000",16).
Example. We rewrite 12& into only 12.
As Decimal BASIC has no syntax about constant declarations, we rewrite them as assignments to variables.
Example. We rewrite Public Const HELP_COMMAND = &H102& into LET HELP_COMMAND = BVAL("102",16)
Also, LET HELP_COMMAND = 258 will do.


Sample programs.

A program that uses Windows console input and output.
After console output, it accepts console input, which is done by typing several characters and pressing the Enter key.

100 DECLARE EXTERNAL FUNCTION GetStdHandle
110 DECLARE EXTERNAL SUB AllocConsole,FreeConsole,WriteFile,CloseHandle 
120 LET o$=REPEAT$("#",4)   ! 4 bytes
130 CALL AllocConsole
140 LET STD_INPUT_HANDLE=-10
150 LET STD_OUTPUT_HANDLE=-11
160 LET n=GetStdHandle(STD_OUTPUT_HANDLE)
170 FOR i=1 TO 30   ! output characters
180    LET s$=STR$(i) & "  " & STR$(SQR(i)) & CHR$(13) & CHR$(10)
190    CALL WriteFile(n, s$ ,LEN(s$),o$,0)
200 NEXT i
210 CALL CloseHandle(n)
220 LET n=GetStdHandle(STD_INPUT_HANDLE)
230 LET inp$=REPEAT$("#",1)   ! 1 byte
240 DO 
250    CALL ReadFile(n,inp$,1,o$,0)    ! key input
260    PRINT inp$(1:1);
270    IF inp$=CHR$(10) THEN EXIT DO   ! Enter key
280 LOOP
290 CALL CloseHandle(n)
300 CALL FreeConsole
310 END
320 EXTERNAL FUNCTION GetStdHandle(n)
330 ASSIGN  "kernel32.dll","GetStdHandle"
340 END FUNCTION
350 EXTERNAL SUB AllocConsole
360 ASSIGN  "kernel32.dll","AllocConsole"
370 END SUB
380 EXTERNAL SUB FreeConsole
390 ASSIGN  "kernel32.dll","FreeConsole"
400 END SUB
410 EXTERNAL SUB WriteFile(n,s$,LENGTH,o$,a)
420 ASSIGN  "kernel32.dll","WriteFile"
430 END SUB
440 EXTERNAL SUB ReadFile(n,s$,LENGTH,o$,a)
450 ASSIGN  "kernel32.dll","ReadFile"
460 END SUB
470 EXTERNAL SUB CloseHandle(n)
480 ASSIGN  "kernel32.dll","CloseHandle"
490 END SUB

Sample(2)

A program that read a file directly using createFile of Windows API.

100 OPTION CHARACTER BYTE
110 DECLARE EXTERNAL FUNCTION CreateFile
120 DECLARE EXTERNAL SUB ReadFile,CloseHandle 
130 LET Name$="C:\BASICw32\README.TXT"          ! designate a really exisitng file
140 LET GENERIC_READ=BVAL("80000000",16)
150 LET OPEN_EXISTING=3
160 LET FILE_ATTRIBUTE_NORMAL=BVAL("80",16)
170 LET s$=REPEAT$("#",1)    ! 1 byte
180 LET w$=REPEAT$("0",1)  ! 4 bytes  
190 LET hfile=CreateFile(Name$,GENERIC_READ,0,0,OPEN_EXISTING,FILE_ATTRIBUTE_NORMAL,0)
200 IF hfile<>-1 THEN
210    DO
220       LET t$=""
230       DO
240          CALL ReadFile(hfile,s$,1,w$,0)
250          IF s$=CHR$(13) THEN                ! assumes that chr$(13) precede chr$(10).
260             CALL ReadFile(hfile,s$,1,w$,0)
270             EXIT DO
280          END IF        
290          IF ORD(w$(1:1))=0 THEN EXIT DO
300          LET t$ = t$ & s$(1:1)              
310          ! if (1:1) lacks in the above, s$ is substituted for t$ if t$="".
320       LOOP       
330       PRINT t$
340       IF ORD(w$(1:1))=0 THEN EXIT DO
350    LOOP
360    CALL closeHandle(hfile)
370 ELSE
380    PRINT "Error"
390 END IF
400 END
410 
420 EXTERNAL FUNCTION CreateFile(Name$, acc ,share, sec, create, attrib, handle)
430 ASSIGN "kernel32.dll","CreateFileA"
440 END FUNCTION
450 
460 EXTERNAL SUB ReadFile(handle, s$, l, w$, ov )
470 ASSIGN "kernel32.dll","ReadFile"
480 END SUB
490 
500 EXTERNAL SUB CloseHandle(handle)
510 ASSIGN "kernel32.dll","CloseHandle"
520 END SUB

十進BASIC掲示板より

 哲さんからの情報です。

実行結果(テキスト出力)のウィンドウを最大化する

100 DECLARE EXTERNAL FUNCTION FndWnd
110 DECLARE EXTERNAL FUNCTION ShowWnd
120 LET hWnd=FndWnd("TTextForm","") 
130 IF hWnd>0 THEN
140    LET n=ShowWnd(hWnd, 3)
150 END IF
160 ! ここに必要な処理(PRNIT文,etc)を書く
170 END
180  
190 EXTERNAL FUNCTION FndWnd(lpClassName$,lpWindowName$)
200 ASSIGN "user32.dll","FindWindowA"
210 END FUNCTION
220  
230 EXTERNAL FUNCTION ShowWnd(hWnd, nCmdShow)
240 ASSIGN "user32.dll","ShowWindow"
250 END FUNCTION
ShowWnd(hWnd, 3) の第2引数は
HIDE =       0
NORMAL =      1
SHOWMINIMIZED =   2
MAXIMIZE =     3
SHOWNOACTIVATE =  4
SHOW =       5
MINIMIZE =     6
SHOWMINNOACTIVE =  7
SHOWNA =      8
RESTORE =      9
SHOWDEFAULT =   10
FORCEMINIMIZE =  11

FndWndの第1パラメータは,描画ウィンドウでは,"TPaintForm",Inputダイアログでは"TInputDialog"です。
BASICを複数起動しているときは,FndWndの第2パラメータに,ウィンドウの上端に表示されるウィンドウの名前(プログラム名の末尾を.TXTまたは.BMPに変えたもの)を指定します。

<補足>CHARACTER INPUT文の実行時に表示されるウィンドウは"TCharInput"です。

MIDI音源を利用して単音を出す

DECLARE EXTERNAL FUNCTION midiOpen
DECLARE EXTERNAL FUNCTION midiMsg
DECLARE EXTERNAL FUNCTION midiClose
! 利用可能なMIDIデバイスの数を獲得
DECLARE EXTERNAL FUNCTION midiGet 
OPTION CHARACTER byte ! 文字サイズを1バイトにする

LET hmid$=REPEAT$("*",4) ! 四バイト分用意

LET Note=70 !音階(&H00から&H7F(127))
LET Inst=0 !楽器No(GM音色番号に準拠?)
LET Vol=BVAL("7F",16) !音量(&H00から&H7F(127))

IF midiGet<1 THEN STOP ! MIDIデバイスがなければ終了
LET n=midiOpen(hMid$, -1, 0, 0, 0)

! 文字列を数値に変換
LET hMidiOut=0
LET k=1
FOR i=1 TO 4
   LET hMidiOut = hMidiOut + k*ORD(hMid$(i:i))
   LET k = k*256
NEXT i

LET n=midiMsg(hMidiOut, BVAL("c0",16) + Inst * 256)
LET n=midiMsg(hMidiOut, BVAL("90",16) + Note * 256 + Vol * 256 * 256) 
WAIT DELAY 1
LET n=midiMsg(hMidiOut, BVAL("80",16) + Note * 256)
LET n=midiClose(hMidiOut)

END
EXTERNAL FUNCTION midiOpen(lphMidiOut$,uDeviceID,dwCallback,dwInstance,dwFlags)
ASSIGN "winmm.dll","midiOutOpen"
END FUNCTION

EXTERNAL FUNCTION midiMsg(hMid,Dt)
ASSIGN "winmm.dll","midiOutShortMsg"
END FUNCTION

EXTERNAL FUNCTION midiClose(hMid)
ASSIGN "winmm.dll","midiOutClose"
END FUNCTION 

EXTERNAL FUNCTION midiGet
ASSIGN "winmm.dll","midiOutGetNumDevs"
END FUNCTION 

WAVファイルを演奏する

DECLARE EXTERNAL FUNCTION PlaySound

LET S$="***.wav"
LET n=PlaySound(S$, "", 128) 
END

EXTERNAL FUNCTION PlaySound(pszSound$, hmod$, fdwSound)
ASSIGN "winmm.dll","PlaySoundA"
END FUNCTION 

汎用DLLを使う

 Visual BASICやC言語用に作られたDLLを使うこともできる。
8ビット,あるいは16ビットの引数は,スタックには32ビット境界にあわせてセットされるため,それらの引数に32ビット値を与えても支障はない(上位ビットが無視される)。
結果型が8ビット,あるいは16ビットである関数の値を使うときは,MOD(x,2^8)またはMOD(x,2^16)を適用して上位ビットを切り捨てる。Visual BASICのBoolean型は16ビットなので,Visual BASIC専用に作られたDLLを使う場合は注意が必要かもしれない。

ディスパッチインターフェースに対応しないCOMコンポーネント,画面表示を伴うActiveXなどは,VB,Delphi,C++など,他言語でDLLを書いて利用する。

<Note>stdcall(Win32 APIの呼び出し規約)でコンパイルされた関数が対象であるが,cdecl(C言語の標準の呼び出し規約)でコンパイルされた関数を呼び出してもとりあえず動く。

<Note>C言語で作成されたDLLには,DLL内で登録されている関数名がマニュアルに書いてあるのと違うものがある。

<Note>DLLをロードできないエラーになるときは,DLLをフルパス名で指定するか,DLLをpathの通ったフォルダに置く,あるいは,プログラムをDLLがあるのと同じフォルダに保存してから実行する。

UNLHA32.DLLを使う

UNHLA32.DLLは,マニュアルがC言語向けに書かれているが,使える。
最も単純なLHA互換機能だけだと次のようになる。

100 REM UNLHA32.DLLをLHAとして使う
110 SUB UNLHA(HWND,CMD$,BUF,NBUF)
120    ASSIGN "UNLHA32.DLL","Unlha"
130 END SUB
140 SUB LHA(CMD$)
150    CALL UNLHA(0,CMD$,0,0)
160 END SUB
170 SET DIRECTORY "c:\****"         ! カレント・ディレクトリを移動する
180 CALL LHA("a ****** *****.txt")  ! 引数に,LHAのコマンドを指定する
190 END

VBIOSCMを使う

 VBIOSCMは,VB6用となっているが,単純に読み替えるだけで使える。
Visual BASICの x and 1 は,MOD(x,2)に置き換えればよい。

サンプルプログラム(Windows MeとWindows XP(SP2)で動作を確認。IBM PC互換機以外では絶対に実行しないでください。)

DECLARE EXTERNAL FUNCTION IOSCM_Start, InpB, InpD, InpW
DECLARE EXTERNAL SUB IOSCM_Stop, OutB, OutD, OutW
REM DOS/V機でビープ音を鳴らす
IF MOD(IOSCM_Start,2)=0 THEN
   LET port=BVAL("61",16)
   LET n=InpB(port)
   CALL OutB(port,INT(n/4)*4+3)  !鳴らす
   PAUSE
   CALL OutB(port,INT(n/4)*4)    !止める 
   CALL IOSCM_Stop
ELSE
   PRINT "IOSCM Init Error!!"
END IF
END

EXTERNAL FUNCTION InpB (port)
FUNCTION InpB_org(port)
   ASSIGN "VBIOSCM_DLL.DLL", "_InpB@4" 
END FUNCTION
LET InpB=MOD(InpB_org(port),2^8)      ! 下位8ビットを取り出す
END FUNCTION

EXTERNAL FUNCTION InpW (port)
FUNCTION InpW_org(port)
   ASSIGN "VBIOSCM_DLL.DLL", "_InpW@4"
END FUNCTION
LET InpW=MOD(InpW_org(port),2^16)    ! 下位16ビットを取り出す
END FUNCTION

EXTERNAL FUNCTION InpD(port)
ASSIGN "VBIOSCM_DLL.DLL", "_InpD@4"
END FUNCTION

EXTERNAL SUB OutB(port, dat)
ASSIGN "VBIOSCM_DLL.DLL", "_OutB@8"
END SUB

EXTERNAL SUB OutW(port, dat)
ASSIGN "VBIOSCM_DLL.DLL", "_OutW@8"
END SUB

EXTERNAL SUB OutD(port, dat)
ASSIGN "VBIOSCM_DLL.DLL", "_OutD@8"
END SUB

EXTERNAL FUNCTION IOSCM_Start
ASSIGN "VBIOSCM_DLL.DLL", "_IOSCM_Start@0"
END FUNCTION

EXTERNAL SUB IOSCM_Stop 
ASSIGN "VBIOSCM_DLL.DLL", "_IOSCM_Stop@0"
END SUB


 同種のDLLに,Robot I/O Port 32 DLL がある。こちらは,有料だけれど,パラレルポートにも対応している。テストはしていないが,Readme.txtを読むかぎりは使えるはず。

jconvlibを使う

 jconv.dllは, DLLに登録された関数の名前がマニュアルの記述と異なるという特徴が現れたDLLである。

まず,jconv.hを見ると,

typedef enum {
  JC_AUTO,
  JC_UTF_7,
  JC_ISO2022JP,
  JC_UTF_8,
  JC_SHIFT_JIS,
  JC_EUC_JP,
  JC_UTF_16_B,
  JC_UTF_16_L,
  JC_UCS_4_B
} JC_JCODE_TYPE;

とある。これは,JC_JCODE_TYPE型の定義で,JC_AUTO,JC_UTF_7,・・・に,0から始まる数値が順に割り当てられていることを意味する。BASICでは,それぞれに順に0から始まる数値を代入しておけば使いやすい。

DLL内のメインの関数jconvを使うために
FUNCTION jconv(InType,In$,InLen,OutType,Out$)
   ASSIGN "jconv.dll","jconv"
END FUNCTION

とすると,翻訳時に「jconvがみつからない」のエラーになる。(DLLはロードできたけれども,関数のエントリーポイントがみつからないということ)
DLL Analyze AZUKIで調べると,関数名のjconvが _jconv@20 に変わってしまっているらしいことがわかる。

jconv.dllの使用サンプル(shift-JIS文字列をWindowsのユニコード文字列に変換)

100 OPTION CHARACTER BYTE
110 SUB MesBoxW(owner,text$,caption$,flag)
120    ASSIGN  "user32.dll","MessageBoxW"
130 END SUB 
140 FUNCTION jconv(InType,In$,InLen,OutType,Out$)
150    ASSIGN "jconv.dll","_jconv@20"
160 END FUNCTION
170 LET  JC_AUTO=0
180 LET  JC_UTF_7=1
190 LET  JC_ISO2022JP=2
200 LET  JC_UTF_8=3
210 LET  JC_SHIFT_JIS=4
220 LET  JC_EUC_JP=5
230 LET  JC_UTF_16_B=6
240 LET  JC_UTF_16_L=7
250 LET  JC_UCS_4_B=8
260 LET s1$="こんにちは"
270 LET s2$="BASIC"
280 LET t1$=REPEAT$("##",LEN(s1$)+1)  ! 結果を受け取るための作業領域 
290 LET t2$=REPEAT$("##",LEN(s2$)+1)  ! 結果を受け取るための作業領域
300 LET text$=t1$(1:jconv(JC_SHIFT_JIS,s1$,LEN(s1$),JC_UTF_16_L,t1$))
310 LET caption$=t2$(1:jconv(JC_SHIFT_JIS,s2$,LEN(s2$),JC_UTF_16_L,t2$))
320 CALL MesBoxW(0,text$,caption$,3)
330 END


<教訓>Visual C++で作成されたDLLで関数名を認識しないときは,関数名の前に_(アンダースコア),関数名の後に@と引数の個数を4倍した数(=引数のバイト数)を付加してみる。

<注意> 空文字列は空文字列へのポインタではなくnullになるので,空文字列をjconvに渡すとエラーになる。

<補足>shift-JIS文字列をWindowsのユニコード文字列に変換したいだけならWin32 APIでできる。 この手のDLLが有用なのは,UTF-8との変換ができること。

Double型実数を変数引数にとるDLL

数式文字列の計算 文字列による数式を計算するDLL

このDLLはC言語の呼び出し規約_cdeclであるが,使える。
このDLLは実数値の入出力を構造体上で行う。引数は構造体へのポインタである。
本BASICでは構造体のバイト数の文字列を確保し,そのアドレスをDLLに渡す。
Double型実数値を構造体上にセットするのに組込関数PackDBL$を使う。
180行のPackDBL$(x)は,xをDouble型に変換して8バイトの文字列に埋め込む。
190行のUnPackDBL関数はその逆の操作を行う。
利用者定義関数のDWord$とVarPtrはLibraryフォルダのAPISUP1.LIBで定義されているので,MERGE文で読み込んで利用する。

100 DECLARE EXTERNAL FUNCTION  DWord$, VarPtr
110 OPTION CHARACTER byte
120 FUNCTION StrCalc(PSTRCALC_PARAM$)
130    ASSIGN "StCalc35.dll","StrCalc"
140 END FUNCTION
150 LET x=2.1
160 LET y=3.3
170 LET s$="5*x-4*y" 
180 LET Param$=DWord$(VarPtr(s$))  & REPEAT$(CHR$(0), 4+4+4)  & PackDBL$(x) & PackDBL$(y) & REPEAT$(CHR$(0),8)
190 IF StrCalc(Param$)=0 THEN  PRINT UnPackDBL(Param$(33:40))
200 END
210 MERGE "APISUP1.LIB" 

実数値を返すDLL関数

 結果の型がDoubleなどの実数値を返す関数をBASICの関数に割り当てるためには,
ASSIGN DLLファイル名 ,関数名 ,FPU
の形のASSIGN文を書く。
この形のASSIGN文を実行すると,FPUのスタックトップレジスタをPOPしてその値をBASICの関数値とする。

例 EPMATH

このDLLには,
__declspec(dllexport) double Kaiseki(char *mojiretu, int *ERR); C言語用
__declspec(dllexport) double __stdcall Kaiseki_VB(char *mojiretu, int *ERR); VB用
の2つの関数が定義されているので,ここでは,下のVB用を利用する。
この関数は,内部で名前が _Kaiseki_VB@8 と変わってしまっている。 BASICでは次のように使う。

100 FUNCTION kaiseki(s$,e$)
110    ASSIGN "EpMath.dll", "_Kaiseki_VB@8", FPU
120 END FUNCTION 
130 INPUT s$
140 LET e$="1234"  ! 4バイト確保
150 LET a=kaiseki(s$,e$)
160 IF ORD(e$(1:1))=0 THEN
170    PRINT a
180 ELSE
190    PRINT "error";ORD(e$(1:1))
200 END IF
210 END



例 Mersenne Twister

山本秀樹氏により作成された Windows上で利用できるMersenne Twister法による擬似乱数列生成ルーチン。
ホームページに Visual BASIC用の宣言例があるので,機械的に翻訳するだけで利用できる。

100 DECLARE EXTERNAL FUNCTION random
110 DECLARE EXTERNAL SUB randomize
120 CALL randomize(567)
130 FOR i=1 TO 100
140    PRINT USING "#.###############": random
150 NEXT i
160 END
170 EXTERNAL FUNCTION random 
180 ASSIGN "libMT.DLL" ,"genrand" , FPU
190 END FUNCTION 
200 EXTERNAL SUB randomize(seed)
210 ASSIGN "libMT.DLL", "sgenrand"
220 END SUB

例 Mersenne Twister DLL版

このDLLにはVB用のサンプルが付属するので,機械的に翻訳すれば使える。
このライブラリには全部で4つのDLLが含まれるが,そのうち,mt19937m.dllは,上と同様に使える。

100 DECLARE EXTERNAL FUNCTION random
110 DECLARE EXTERNAL SUB randomize
120 CALL randomize(4357)
130 FOR i=1 TO 100
140    PRINT USING "#.###############": random
150 NEXT i
160 END
170 EXTERNAL FUNCTION random 
180 ASSIGN "mt19937m.dll" ,"genrandm" ,FPU
190 END FUNCTION 
200 EXTERNAL SUB randomize(seed)
210 ASSIGN "mt19937m.dll","sgenrandm"
220 END SUB


mt19937ar.dllの場合は次のようになる。
不定長整数配列への参照引数を要求するinit_by_arrayは文字列変数を引数にして利用する。

100 DECLARE EXTERNAL FUNCTION genrand_real2, genrand_int32
110 DECLARE EXTERNAL SUB  init_by_array, init_genrand
120 LET init_key$=REPEAT$(CHR$(0),16)                               ! DIM init_key(3) As Long
130 LET init_key$( 1: 2)=CHR$(BVAL("23",16)) & CHR$(BVAL("01",16))  ! init_key(0) = &H123
140 LET init_key$( 5: 6)=CHR$(BVAL("34",16)) & CHR$(BVAL("02",16))  ! init_key(1) = &H234
150 LET init_key$( 9:10)=CHR$(BVAL("45",16)) & CHR$(BVAL("03",16))  ! init_key(2) = &H345
160 LET init_key$(13:14)=CHR$(BVAL("56",16)) & CHR$(BVAL("04",16))  ! init_key(3) = &H456
170 CALL init_by_array(init_key$, 4)                                ! init_by_array init_key(0), 4
180 ! CALL init_genrand (4357)                                      ! 'init_genrand (4357)
190 FOR j = 1 TO 100
200    PRINT USING "#.###############": genrand_real2
210 NEXT j
220 END
230 
1000 ! Public Declare Function genrand_real2 Lib "mt19937ar" () As Double
1010 EXTERNAL FUNCTION genrand_real2
1020 ASSIGN "mt19937ar.dll", "genrand_real2" ,FPU
1030 END FUNCTION
1040 
1100 ! Public Declare Function genrand_int32 Lib "mt19937ar" () As Long
1110 EXTERNAL FUNCTION genrand_int32
1120 ASSIGN "mt19937ar.dll" , "genrand_int32"
1130 END FUNCTION
1140 
1200 ! Public Declare Sub init_by_array Lib "mt19937ar" (ByRef init_key As Long, ByVal key_length As Long)
1210 EXTERNAL SUB init_by_array (init_key$, key_length)
1220 ASSIGN "mt19937ar.dll", "init_by_array" 
1230 END SUB
1240 
1300 ! Public Declare Sub init_genrand Lib "mt19937ar" (ByVal seed As Long)
1310 EXTERNAL SUB init_genrand(seed)
1320 ASSIGN "mt19937ar.dll", "init_genrand" 
1330 END SUB


<補足>
 機能語RNDはFull BASICの予約語なので,乱数の名前をRNDに変えて使うことはできませんが,それ以外であれば,RANDOMなど,適宜,別の名前に変えて使うことが可能です。

<Note>
DLLをロードできないエラーになるときは,DLLをフルパス名で指定するか,プログラムをDLLがあるのと同じフォルダに保存してから実行してください。



戻る    DLLを自作する