命令語、関数のうち、以下の5つのVer3.xへのエミュレート案です。
- LineInput #
SetClipStr
ClipStr$
OwnerWnd()
CmdLine$
クリップボードに関するクラスがすでに投稿されていますが、
まぁこちらは、Ver2.xの表記を好んでいる方向け、ってことで。
Ver3.13 Final Edition で動作確認しています。
Ver3.xのコードはVer4.xへもそのまま流用できるはずですので、
Ver4.xでも動作すると思います。
コード: 全て選択
'******************************************************
' Ver2.x記述重視のVer3.x用の関数エミュレート
'
' 【命令語】
' LINEINPUT filenumber, buf
' SetClipStr buf
'
' 【関数】
' ClipStr() ※クリップボードのテキスト(String型)が返ります。
' OwnerWnd() ※プロンプト・ウィンドウのハンドル(Long型)が返ります。
' CmdLine() ※コマンドライン引数(String型)が返ります。
'
'******************************************************
'WsCmdLine()内で利用。
Declare Function PathGetArgs Lib "shlwapi" Alias "PathGetArgsA" (psz As BytePtr) As BytePtr
'LineInputのエミュレート案
Macro LINEINPUT( FileNumber As Long, ByRef strBuffer As String )
Dim nLenght As Long
nLenght = __WsLineInput_GroupOpenCloseAB( FileNumber, strBuffer )
End Macro
'ClipStrのエミュレート案
'最大 MaxGetClipStr [Byte] まで取り込みます。
' ※10KBとか指定が大きすぎると、ActiveBasicが落ちかねないので注意!
Const MaxGetClipStr = 1024
Function ClipStr() As String
Dim retAns As Long
Dim pBuffer As BytePtr
ClipStr = ZeroString( MaxGetClipStr + 1 )
pBuffer = StrPtr( ClipStr )
retAns = WsClipStr( pBuffer, MaxGetClipStr )
If( retAns=FALSE )Then
ClipStr = ""
Else
ClipStr = pBuffer
EndIf
EndFunction
'SetClipStrのエミュレート案
Macro SetClipStr( strBuffer As String )
Dim retAns As Long
Dim pBuffer As BytePtr
pBuffer = StrPtr( strBuffer )
retAns = WsSetClipStr( pBuffer )
End Macro
'OwnerWnd()のエミュレート案
Function OwnerWnd() As Long
OwnerWnd = WsOwnerWnd()
EndFunction
'CmdLine()のエミュレート案
Function CmdLine() As String
CmdLine = WsCmdLine()
EndFunction
'*****************************************************************
'以下、エミュレート関数本体。
'クリップボードが文字列であれば、最大nMax文字数をpBufferへ格納。
'返り値はTRUE or FALSE
Function WsClipStr( pBuffer As BytePtr, nMax As Long ) As Long
Dim pAddUrl As BytePtr
Dim pMark As BytePtr
Dim hRawClip As DWord
'クリップボードを開く
While ( OpenClipboard(0)=FALSE )
Sleep (1)
Wend
'クリップボードのデータを得る。
hRawClip = GetClipboardData( CF_TEXT )
If( hRawClip=NULL )Then
pMark = NULL
WsClipStr = FALSE
Else
pMark = GlobalLock( hRawClip )
If( pMark=NULL )Then
pMark = hRawClip
pBuffer = WsStrncpy( pBuffer, pMark, nMax-1 )
Else
pBuffer = WsStrncpy( pBuffer, pMark, nMax-1 )
GlobalUnlock( pBuffer )
EndIf
WsClipStr = TRUE
EndIf
'クリップボードを閉じる
CloseClipboard()
EndFunction
'クリップボードに文字列を貼り付ける。
'返り値はTRUE
Function WsSetClipStr( pBuffer As BytePtr ) As Long
Dim nSize As Long
Dim hGlobalMem As DWord
Dim pGlobalMemForClipText As BytePtr
'クリップボードを開く
While ( OpenClipboard(0)=FALSE )
Sleep (1)
Wend
'クリップボードを空にする。
EmptyClipboard()
'貼り付ける文字列の大きさを得て、クリップボード用のバッファを確保
nSize = lstrlen( pBuffer )
hGlobalMem = GlobalAlloc( GHND Or GMEM_SHARE, nSize + 1 )
pGlobalMemForClipText = GlobalLock(hGlobalMem)
pGlobalMemForClipText = lstrcpy( pGlobalMemForClipText, pBuffer )
GlobalUnlock( hGlobalMem )
SetClipboardData( CF_TEXT, hGlobalMem )
'クリップボードを閉じる
CloseClipboard()
WsSetClipStr = TRUE
EndFunction
'LineInputのエミュレート案:本体。
' FileNumber As Long → Open文で開いたファイルナンバー
' ByRef strBuffer As String → 読み込む文字列バッファー
' 返り値は、読み込んだ文字数になります。
' ※本家Discoverのプログラム掲示板の「高信期さん」の改良案を利用。
' ※※対応終端コード:LF, CR, CR+LF
Function __WsLineInput_GroupOpenCloseAB( FileNumber As Long, ByRef strBuffer As String ) As Long
Dim Buf As BytePtr
Dim Size As Long
Dim Length As Long
FileNumber = FileNumber - 1
Size = GetFileSize( _System_hFile[FileNumber], 0 )
Size = Size - SetFilePointer( _System_hFile[FileNumber], 0, NULL, FILE_CURRENT )
Buf = calloc( Size + 1 )
ReadFile( _System_hFile[FileNumber], Buf, Size, VarPtr(Size), ByVal NULL )
Length = 0
While TRUE
Select Case Buf[Length]
Case NULL
Exit While
Case 10 'LF
SetFilePointer( _System_hFile[FileNumber], Length + 1 - Size, NULL, FILE_END )
Exit While
Case 13 'CR or CRLF
SetFilePointer( _System_hFile[FileNumber], _
Length + 1 - ( Buf[Length + 1] = 10 ) - Size, _
NULL, _
FILE_END )
Exit While
Case Else
Length = Length + 1
End Select
Wend
strBuffer = ZeroString(Length)
memcpy(StrPtr(strBuffer), Buf, Length)
'読み込んだ文字数を返す。
__WsLineInput_GroupOpenCloseAB = lstrlen( Buf )
free(Buf)
EndFunction
'プロンプトウインドウのハンドルを得る関数。
Function WsOwnerWnd() As Long
WsOwnerWnd = _PromptSys_hWnd
EndFunction
'コマンドライン文字列の取得関数。
Function WsCmdLine() As BytePtr
Dim pRowCodLine As BytePtr
pRowCodLine = GetCommandLine()
WsCmdLine = PathGetArgs( pRowCodLine )
EndFunction
'**************************************************************
' WsClipStr() 内で使用する関数。
'**************************************************************
'NULL文字を含め、文字列 poPaste を最大 nMax 文字まで 文字列バッファpoBuffer にコピーする.
'poBuffer を返す。C言語のstrncpy()に相当。
Function WsStrncpy( poBuffer As BytePtr, poPaste As BytePtr, nMax As Long ) As BytePtr
WsStrncpy = WsStrCpyNum( poBuffer, poPaste, nMax )
EndFunction
'本体
Function WsStrCpyNum( poBuffer As BytePtr, poPaste As BytePtr, nMax As Long ) As BytePtr
dim nLength As Long
dim i As Long
nLength = lstrlen( poPaste )
If( nLength<nMax-1 )Then
poBuffer = lstrcpy( poBuffer, poPaste )
Else
For i=0 To nMax-2
SetByte( poBuffer+i, GetByte( poPaste+i ) )
Next
i = nMax-1
SetByte( poBuffer+i, 0 )
EndIf
WsStrCpyNum = poBuffer
EndFunction
を指定することを前提にしています。・・・無くても動くのかしら?
使い方は以下のとおり。
LineInput filenumber, buf
Open命令、Close命令と共に使います。
Input #1, buf ではカンマ区切りで読み込んできますが、
LineInput 1, buf では行単位(終端はLF or CR or CR+LF)で読み込みます。
データを読み取った分、ファイルポインタが移動します。
bufにはString型を指定してください。
Input # 命令と混在して使えるのが魅力ですw
※【Line Input #1】という記述は出来ません。
【LineInput 1】でお願いします。
SetClipStr buf
クリップボードに文字列を格納します。
bufには格納する文字列(String型)を指定します。
ClipStr()
クリップボードにセットされている文字列を取得します。
クリップボードにテキスト以外のデータがセットされているときは、
長さが 0 の文字列が返ります。
定義 Function ClipStr() As String
OwnerWnd()
メインのプロンプト ウィンドウのウィンドウ ハンドルを取得します。
ウィンドウ ハンドルが返ります。
定義 Function OwnerWnd() As Long
CmdLine()
コマンド ライン文字列を取得します(コンパイル時のみ)。
コマンド ラインが格納された文字列が返ります。
定義 Function CmdLine() As String
・・・ってVer2.x 時代から使っている方や、未だにVer3.xに
拘っているような方なら、書かなくても分かるでしょうね(^^;)
Ver2.xのヘルプファイルの説明文をだいぶ拝借させていただきましたm(_ _)m
Ver2.x時代と同じ記述ができることを重視していますので。
あの手軽さが好きなのです♪(時代逆行中)
・・・でも、最近はVer3.xの速さに誘惑されてるかな?
蛇足。
Function WsStrncpy() なんぞを定義しているのは、C言語のstrncpy()が
欲しかったから。他にも strstr() や strchr() が欲しかったりしますが、
Apiの定義がわからんのです・・・。なので自作実装。
Apiの宣言の仕方を知ってる方いらっしゃいますか?
居りましたら、ぜひ教えていただきたいのですが・・・。
・・・InStr() があるじゃないか、というツッコミはなしで(苦笑)。