ab.com コミュニティ https://www.activebasic.com/forum/ |
|
[AB3] LineInput,SetClipStr,ClipStr(),OwnerWnd(),CmdLine() https://www.activebasic.com/forum/viewtopic.php?t=214 |
ページ 1 / 1 |
作成者: | 淡幻星 [ 2005年7月20日(水) 08:44 ] |
記事の件名: | [AB3] LineInput,SetClipStr,ClipStr(),OwnerWnd(),CmdLine() |
Ver2,x → Ver3.x へのバージョンアップに伴って消えた 命令語、関数のうち、以下の5つのVer3.xへのエミュレート案です。
クリップボードに関するクラスがすでに投稿されていますが、 まぁこちらは、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#N88BASIC を指定することを前提にしています。・・・無くても動くのかしら? 使い方は以下のとおり。 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() があるじゃないか、というツッコミはなしで(苦笑)。 |
作成者: | イグトランス [ 2005年7月20日(水) 19:49 ] |
記事の件名: | |
strncpy()の代わりはWin32APIにlstrcpy()が在ります。 Declare Function lstrcpy Lib "kernel32" Alias "lstrcpyA" (pString1 As BytePtr, pString2 As BytePtr, iMaxLength As Long) As BytePtr ほかにもshlwapi.dllにStrStr()やShrChr()など大抵のものは在りますが、このDLLはIE4以降に付属するものなので、プログラムを実行するユーザがWin95辺りだとIE4以降をインストールしてもらうことになります。 |
作成者: | 淡幻星 [ 2005年7月21日(木) 08:40 ] |
記事の件名: | lstr周り |
イグトランス様、ありがとうございます。 確かに呼び出せました。 でもlstrcpyA→lstrcpynAの間違いですよね? 最初、オーバーロード?とか思っちゃいました。 コード: 'lstrncpy() Declare Function lstrncpy Lib "kernel32" Alias "lstrcpynA" _ ( pBuffer1 As BytePtr, _ pBuffer2 As BytePtr, _ iMaxLength As Long ) As BytePtrstrstrなども見つけられました。shlwapi.dllですか。知りませんでした。 Shell Lightweight Utility APIs:文字列操作が便利になるAPIで、Win98以降なら標準であるみたいですね。 せっかくなので、string.hの標準関数のいくつかをAPIで置き換える場合の宣言をいくつかメモ。 ※ABのIncludeでまだ定義されていないもの(Ver4.03時点)。 ※※大文字、小文字は区別しない。区別する場合はAliasから[ I ]を外せばよい。 コード: 'strncat() Declare Function lstrncat Lib "shlwapi" Alias "StrNCatA" _ ( pString1 As BytePtr, _ pString2 As BytePtr, _ iMaxLength As Long ) As BytePtr 'strstr() Declare Function lstrstr Lib "shlwapi" Alias "StrStrIA" _ ( pBuffer1 As BytePtr, _ pBuffer2 As BytePtr ) As BytePtr 'strchr() Declare Function lstrchr Lib "shlwapi" Alias "StrChrIA" _ ( pBuffer1 As BytePtr, _ bSearch2 As Byte ) As BytePtr 'strrchr() Declare Function _lstrrchr Lib "shlwapi" Alias "StrRChrIA" _ ( pBufStart As BytePtr, _ pBufEnd As BytePtr, _ bSearch2 As Byte ) As BytePtr Function lstrrchr( pBuffer1 As BytePtr, bSearch2 As Byte ) As BytePtr lstrrchr = _lstrrchr( pBuffer1, _ pBuffer1 + lstrlen(pBuffer1), _ bSearch2 ) EndFunctionString型で事足りる限りは、つまりはでかい文字列を扱わない限りは、必要の無い関数ですけどね(苦笑)。 |
作成者: | 淡幻星 [ 2005年7月21日(木) 09:11 ] |
記事の件名: | 追記:String型とオーバーフロー |
> String型で事足りる限りは、つまりはでかい文字列を扱わない限りは Ver3.xで、512(1024だったかな?)ほどのString型配列を用意した際に スタックオーバーフローで落ちた記憶があったので、こう発言したのですが、 引用: ・データを格納するためのメモリがヒープ領域に設けられる
という文章をHELPに今しがた見つけました。ということは、Ver4.xであれば、String型で落ちるなんてことを経験した人は居ないんでしょうか? いえ、ちょっと疑問に思っただけです(^^;) それから。 MakeStr()は省略しても動きますね。 Ver3.xと互換取れてるようで嬉しいです。 追記その2 strstrなどの実装は、shlwapi.dllを使うより、crtdll.dllを使ったほうが良いんでしょうかねぇ? 引用: crtdll.dll
だそうなので。・・・いまどき、どっちでも良いですか(^^;)
CのRunTimeライブラリのDLLで、windowsのシステムディレクトリに最初からある。 |
作成者: | NoWest [ 2005年7月21日(木) 16:05 ] |
記事の件名: | Re: 追記:String型とオーバーフロー |
> 追記その2 > strstrなどの実装は、shlwapi.dllを使うより、crtdll.dllを使ったほうが良いんでしょうかねぇ? > 引用: crtdll.dll
> だそうなので。・・・いまどき、どっちでも良いですか(^^;)> CのRunTimeライブラリのDLLで、windowsのシステムディレクトリに最初からある。 crtdll.dllにはsin()とかcos()とかも最初から入っています。 ですので、今、math.hの移植を行っています。 ついでにprocess.h、time.hも移植してみましたらABでも動きました。 ただbeginthread()関数はABでは少し動作に問題がでましたが beginthreadex()関数は普通に動きます。 呼び出し規約にさえ気をつければcrtdllを使っても大丈夫でしょう。 |
作成者: | 渡辺真 [ 2006年6月17日(土) 03:11 ] |
記事の件名: | [AV4]だと、無効な識別子です |
お世話になっています。 AV3で動いている"LineInput" を、AV4でデバッグ実行すると、 "LineInput" 無効な識別子です と言われます。 修正方法などお教え願えれば幸いです。 http://makotowatana.ld.infoseek.co.jp/ |
作成者: | 淡幻星 [ 2006年6月17日(土) 22:00 ] |
記事の件名: | Re: [AV4]だと、無効な識別子です |
引用: > 修正方法などお教え願えれば幸いです。 現在AB環境がないので確認できませんが、以下の修正方法を試してみてください。 コード: 'LineInputのエミュレート案 Macro LINEINPUT( FileNumber As Long, ByRef strBuffer As String )の部分を コード: 'LineInputのエミュレート案 Macro LineInput( FileNumber As Long, ByRef strBuffer As String )に書き換える。 それでもダメな場合は、 コード: 'LineInputのエミュレート案 Macro LINEINPUT( FileNumber As Long, ByRef strBuffer As String ) Dim nLenght As Long nLenght = __WsLineInput_GroupOpenCloseAB( FileNumber, strBuffer ) End Macroを コード: Sub LineInput( FileNumber As Long, ByRef strBuffer As String ) Dim nLenght As Long nLenght = __WsLineInput_GroupOpenCloseAB( FileNumber, strBuffer ) End Subに書き換えて、呼び出し方法をSubにあわせてください。 たしか、上記の方法でAB4でも動作した、と言う話を聞いたことがあります。 蛇足。 AV4=Activebasic Version4.xの略ですよね? 最初、「AVって何??」とか思いましたもんでw |
作成者: | 渡辺真 [ 2006年6月17日(土) 23:31 ] |
記事の件名: | お礼!AB4で動きました。 |
有難うございます。 AB4(VBと混同して、AV4と書きましたが、まさしくAB4のことです。)で、 'LineInputのエミュレート案 をSubにして、 呼び出し方法を、Subにあわせて、LineInput(1, IN_DATA$)のようにしたら、 動きました。 迅速な回答、有難うございました。 m(__)m ちなみに私は、ABをインストールするフォルダの名前を下記のようにして、3世代のいずれも動くようにしています。 ActiveBasic2 ActiveBasic3 ActiveBasic4 レジストリは一つしか持てないですが、プログラムから直接起動させない限り、問題有りません。 |
ページ 1 / 1 | 全ての表示時間は UTC+09:00 です |
Powered by phpBB® Forum Software © phpBB Limited https://www.phpbb.com/ |