明けましておめでとうございます。
PC2台とルータを用意して小さなネットワーク環境で勉強を続けています。
(以前、ネットワーク関係は迷惑になるのでクローズドで!と)
さて、山の物とも海の物とも分からなかったものが、雲の様には形を成してまいりました。
で、ローカルIPアドレス内でファイルの転送はできないものかと
諸先輩方のコードを拝借しつつゴテゴテと繋ぎ合わせて見たものの
小さなファイルの転送は問題なくできましたが
ある程度の大きなファイルとなるとエラーを出す事があります。
それが通信の初めや終わりなら分かるのですが
あと3回の通信で終わるときや、あと5回で終わると言った終盤でエラーが出ると。。
エラー番号が5でアクセスが拒否されました。と出るのですが
拒否されるならタイミングも変わってよさそうなのですが、終盤に多くでます。
受信回数を見ていると同じファイルは同じ回数でいつも止まります。
また、成功するときもあるのです。
かれこれ100時間以上悩んで、ネットでも関連を調べたのですが出口が見えず
再びこちらでご指導いただけないものかと思い書き込んだ次第です。
あとSendMessageの194ってなんのメッセージなのでしょう?
調べまくりましたが、194に対応するウィンドウメッセージが分かりませんでした。
ずっと謎です。。
エディットボックスは5個1から順に
状態表示、受信フォルダ指定、送信ファイル指定、送信アドレス指定、プログラムからのメッセージの枠としています。
ファイルは、ヒープに読み込んだ後に、先頭に名前+&h0+読込んだファイルと
ヒープメモリーを新たに確保し名前を先頭に付けて&h0を区切りとしてまとめて送っています。
受信側では、それを名前とファイル本体に分解し保存しています。
コードを参照させて頂いた諸先輩方に感謝とお許しを申し上げます。
コード:
#include "IpFileChenger.idx"
'reader
Const BFFM_INITIALIZED = 1
Const BFFM_SETSELECTIONA = WM_USER + 102
Const BFFM_SETSELECTION = BFFM_SETSELECTIONA
Const WM_SOCKET = WM_USER+&H100
Typedef PIDLIST = VoidPtr
Declare Function accept Lib "wsock32.dll" (ByVal s As Long,ByRef addr As SOCKADDR_IN,ByVal addrlen As VoidPtr) As Long
Declare Function inet_ntoa Lib "wsock32.dll" (ByVal lngIn As Long) As BytePtr
Declare Function bind Lib "wsock32.dll" (ByVal s As Long,ByRef sName As SOCKADDR_IN, ByVal namelen As Long) As Long
Declare Function listen Lib "wsock32.dll" (ByVal s As Long, ByVal backlog As Long) As Long
Declare Function WSAAsyncSelect Lib "wsock32.dll" (ByVal s As Long, ByVal hWnd As HWND, ByVal wMsg As Long, ByVal lngEvent As Long) As Long
'sender
Declare Function inet_addr Lib "ws2_32.dll" ( addr As BytePtr) As DWord
Declare Function WSAGetLastError Lib "ws2_32.dll" () As Long
'---------------------------
' Window Message Loop
'---------------------------
Dim msgMain As MSG, iResult As Long
Do
iResult=GetMessage(msgMain,0,0,0)
If iResult=0 or iResult=-1 Then Exit Do
TranslateMessage(msgMain)
DispatchMessage(msgMain)
Loop
' Call destructores and exit process
End
'-----------------------------------------------------------------------------
' イベント プロシージャ
'-----------------------------------------------------------------------------
' このファイルには、ウィンドウ [MainWnd] に関するイベントをコーディングします。
' ウィンドウ ハンドル: hMainWnd
' TODO: この位置にグローバルな変数、構造体、定数、関数を定義します。
Dim listen_s As SOCKET
Dim ntoa As BytePtr
Dim wsad As WSADATA
Dim accept_s As SOCKET
Dim addrsize As Long
Dim addr As SOCKADDR_IN
Dim membuf As BytePtr
TypeDef SOCKET = DWord
dim recvcont as long
'-----------------------------------------------------------------------------
' ウィンドウメッセージを処理するためのコールバック関数
Function MainWndProc(hWnd As HWND, dwMsg As DWord, wParam As WPARAM, lParam As LPARAM) As DWord
' TODO: この位置にウィンドウメッセージを処理するためのコードを記述します。
If dwMsg=WM_SOCKET Then
Select Case LOWORD(lParam)
Case FD_ACCEPT
ptdata(GetDlgItem(hMainWnd,EditBox1),"ソケット受信")
addrsize = SizeOf(SOCKADDR_IN)
accept_s = accept(listen_s,addr,VarPtr(addrsize))
ntoa = inet_ntoa(addr.sin_addr)
ptdata(GetDlgItem(hMainWnd,EditBox1),Str$(htons(addr.sin_port))+"からの接続を受け付けました")
membuf =HeapAlloc(GetProcessHeap(),HEAP_ZERO_MEMORY,1)
Case FD_CLOSE
ptdata(GetDlgItem(hMainWnd,EditBox1),"受信終了")
ADText("受信回数 "+Str$(recvcont)+ex" 切断\r\n\r\n")
shutdown(accept_s,SD_BOTH)
closesocket(accept_s)
'データを名前とデータに分解する
makedata(membuf)
Case FD_READ
ptdata(GetDlgItem(hMainWnd,EditBox1),"受信中")
IpRecv(accept_s)
End Select
End If
' イベントプロシージャの呼び出しを行います。
MainWndProc=EventCall_MainWnd(hWnd,dwMsg,wParam,lParam)
End Function
Function BrowseCallbackProc(hwnd As HWND, msg As DWord, lp As LPARAM, lpData As LPARAM) As LRESULT
If msg = BFFM_INITIALIZED Then
SendMessage(hwnd, BFFM_SETSELECTION, TRUE, lpData) End If
End Function
'-----------------------------------------------------------------------------
' ここから下は、イベントプロシージャを記述するための領域になります。
Sub MainWnd_Destroy()
closesocket(listen_s)
WSACleanup()
IpFileChenger_DestroyObjects()
PostQuitMessage(0)
End Sub
Sub MainWnd_Create(ByRef CreateStruct As CREATESTRUCT)
Dim stwinsock as long
Const FD_READ = 1<<0
Const FD_WRITE = 1<<1
Const FD_OOB = 1<<2
Const FD_ACCEPT = 1<<3
Const FD_CONNECT = 1<<4
Const FD_CLOSE = 1<<5
Const FD_QOS = 1<<6
Const FD_GROUP_QOS = 1<<7
Const FD_ROUTING_INTERFACE_CHANGE = 1<<8
Const FD_ADDRESS_LIST_CHANGE = 1<<9
Const FD_ALL_EVENTS = 1<<10 - 1
addr.sin_family = AF_INET
addr.sin_port = htons(7)'htons(6824)
addr.sin_addr = htonl(0)
stwinsock=WSAStartup(MAKEWORD(2,0),wsad)
if stwinsock<>0 then
msgbox 0,"ソケットの初期化に失敗しました","エラー"
MainWnd_Destroy()
exit sub
end
end if
while -1
if WSAGetLastError()=WSANOTINITIALISED then 'エラー番号 未開始 10093
_errer(0,"開始")
Continue
end if
exit while
wend
listen_s = socket(AF_INET,SOCK_STREAM,0)
bind(listen_s,addr,SizeOf(SOCKADDR_IN))
listen(listen_s,1)
WSAAsyncSelect(listen_s,hMainWnd,WM_SOCKET,FD_ACCEPT Or FD_CLOSE Or FD_READ)
End Sub
Function Dataload(FileName As BytePtr) As BytePtr
Dim Data As BytePtr
Dim FileSize As DWord
Dim hFile As HANDLE
Dim RBytes As Long
hFile=CreateFile(FileName,GENERIC_READ,0,ByVal 0,OPEN_EXISTING,FILE_ATTRIBUTE_NORMAL,0)
FileSize=GetFileSize(hFile,NULL)
if FileSize=0 then
Dataload=0
exit Function
end if
Data=HeapAlloc(GetProcessHeap(),HEAP_ZERO_MEMORY,FileSize+1)
ReadFile(hFile,Data,FileSize,VarPtr(RBytes),ByVal 0)
CloseHandle(hFile)
Dataload=Data
End Function
Function Datasave(rh as HANDLE, ReadData as BytePtr , pass as BytePtr , jc as byte) as byte
'CSVデータセーブ
'dim pass as BytePtr
dim name as string
dim a as long
dim l as long
Dim hFile As HANDLE
Dim SaveSize As DWord
Dim lpMsgBuf As BytePtr
SaveSize=HeapSize(rh,0,ReadData)
if SaveSize<1 then
if jc=0 then msgbox 0,"保存するデータがありません。","未完了"
Datasave=0
exit Function
end if
if ReadData[SaveSize-1]=0 then
SaveSize=SaveSize-1
end if
hFile=CreateFile(pass,GENERIC_WRITE,0,ByVal 0,CREATE_ALWAYS,FILE_ATTRIBUTE_NORMAL,0)
if hFile=INVALID_HANDLE_VALUE then
'エラー詳細
FormatMessage(FORMAT_MESSAGE_ALLOCATE_BUFFER or FORMAT_MESSAGE_FROM_SYSTEM or FORMAT_MESSAGE_IGNORE_INSERTS, _
NULL, _
GetLastError(), _
LANG_USER_DEFAULT, _
VarPtr(lpMsgBuf), _
0, _
NULL)
MessageBox(0,lpMsgBuf,"Error msg",MB_OK)
LocalFree(lpMsgBuf)
end if
if hFile<>INVALID_HANDLE_VALUE then
WriteFile(hFile,ReadData,SaveSize,VarPtr(SaveSize),ByVal 0)
end if
CloseHandle(hFile)
if SaveSize>0 then Datasave=1
if SaveSize=0 then Datasave=0
if SaveSize=0 and jc=0 then msgbox 0,"保存できませんでした。","未完了"
if SaveSize>0 and jc=0 then msgbox 0,"保存完了しました。","ファイルサイズ "+Str$(SaveSize)+" bytes"
End Function
Function opfile(fil as BytePtr , ft as byte) as BytePtr
Dim ofn As OPENFILENAME
Dim FileFilter As String
Dim buffer As String
'OPENFILENAME構造体の初期化
FillMemory(VarPtr(ofn),Len(ofn),0)
ofn.lStructSize=Len(ofn) '構造体のサイズ
ofn.hwndOwner=hMainWnd '親ウィンドウ(ここではデスクトップ ウィンドウを指定)
FileFilter="すべてのファイル(*.*)" + Chr$(0) + "*" + Chr$(0) + Chr$(0)
ofn.lpstrFilter=StrPtr(FileFilter)
ofn.nFilterIndex=1 'ファイル フィルターの数
buffer=ZeroString(500) 'パスを格納するための文字列バッファを確保
ofn.lpstrFile=StrPtr(buffer)
ofn.lpstrInitialDir=fil
ofn.nMaxFile=500 'バッファのバイト数
ofn.lpstrTitle="送信ファイルの指定" 'タイトル
ofn.Flags=OFN_FILEMUSTEXIST or OFN_HIDEREADONLY or OFN_PATHMUSTEXIST
'「ファイルを開く」ダイアログ ボックスを表示
If GetOpenFileName(ofn)=0 Then
'キャンセル ボタンが押されたとき(プロセス終了)
opfile=0
Exit Sub
End If
free(fil)
fil=calloc(lstrlen(ofn.lpstrFile)+1)
lstrcpy(fil,ofn.lpstrFile)
opfile=fil
End Function
Function OpenFolder(hWnd As HWND, InitialFolder As BytePtr) As String
'フォルダー選択
Dim bi As BROWSEINFO
Dim pidlBrowse As VoidPtr
'BROWSEINFO構造体の初期化
FillMemory(VarPtr(bi), Len(bi), 0)
With bi
.hwndOwner=hWnd
.lpszTitle = "フォルダの選択"
.ulFlags = BIF_RETURNONLYFSDIRS or BIF_EDITBOX
.lParam = InitialFolder As LPARAM
.lpfn = AddressOf(BrowseCallbackProc)
End With
'「フォルダの参照」ダイアログボックスを表示
pidlBrowse = SHBrowseForFolder(bi) As PIDLIST
If pidlBrowse Then
'フォルダへのパスを取得
Dim folder[ELM(MAX_PATH)] As Byte
SHGetPathFromIDList(pidlBrowse, folder)
OpenFolder = folder
Else
OpenFolder = ""
End If
End Function
Function gtdata(hDW as HWND) as BytePtr
'エディットボックスから文字取得
Dim l as long
Dim x as long
Dim t as BytePtr
l=SendMessage(hDW,WM_GETTEXTLENGTH,0,0)+1
t=calloc(l+1)
GetWindowText(hDW,t,l)
gtdata=t
end function
Sub ptdata(hDW as HWND , data as BytePtr)
'エディットボックスに文字設定
SetWindowText(hDW,"")
SendMessage(hDW,194,0,data)
end sub
Sub MainWnd_CommandButton1_Click()
Dim hEdit as HWND
Dim i_f as BytePtr
Dim fdps as String
i_f=gtdata(GetDlgItem(hMainWnd,EditBox2))
fdps=OpenFolder(0,i_f)
if Len(fdps)=0 then exit sub
if Len(fdps)=3 then fdps="C:"
hEdit=GetDlgItem(hMainWnd,EditBox2)
SetWindowText(hEdit,StrPtr(fdps))
free(i_f)
End Sub
Sub MainWnd_CommandButton2_Click()
if membuf<>0 then
HeapFree(GetProcessHeap(),0,membuf)
membuf=0
end if
ptdata(GetDlgItem(hMainWnd,EditBox1),"受信待機中")
recvcont=0
End Sub
Sub MainWnd_CommandButton3_Click()
Dim fil as BytePtr
fil=gtdata(GetDlgItem(hMainWnd,EditBox3))
fil=opfile(fil,0)
'クリックした時のリンク先
if lstrlen(fil)>0 then SetWindowText(GetDlgItem(hMainWnd,EditBox3),fil)
free(fil)
end Sub
Sub MainWnd_CommandButton4_Click()
Dim lanadd as BytePtr '送る先のアドレス
Dim fil as BytePtr 'ファイルのフルパス
Dim filedata as BytePtr 'ファイルを読込む為のポインタ
Dim data as BytePtr 'ファイル名を含むファイルデータ ファイル名 &h0 ファイルデータ
Dim yn as long 'アンサー変数
Dim filename as BytePtr '送るファイルの名前(非フルパス)
Dim fl as long '計算変数
Dim l as long '計算変数
Dim x as long '計算変数
Dim c as long '計算変数
fil=gtdata(GetDlgItem(hMainWnd,EditBox3))
lanadd=gtdata(GetDlgItem(hMainWnd,EditBox4))
'データが揃っているか調査
if lanadd=0 then
msgbox 0,"lanアドレスを正しく入力してください","errer"
exit sub
end if
if lstrlen(lanadd)<2 then
msgbox 0,"lanアドレスを正しく入力してください","errer"
exit sub
end if
if fil=0 then
msgbox 0,"ファイルを正しく指定してください","errer"
exit sub
end if
if lstrlen(fil)<2 then
msgbox 0,"ファイルを正しく指定してください","errer"
exit sub
end if
'後ろから「\」までコピー
l=lstrlen(fil)
for x=l to 0 step -1
if fil[x]=&h5C then
exit for
end if
next
if l<x+1 then
free(fil)
free(lanadd)
free(filename)
msgbox 0,"ファイル名が見つかりません","error"
exit sub
end if
'ファイル名のみコピー
l=l-x-1 'ファイル名の長さ
filename=calloc(l+1)
memcpy(filename,VarPtr(fil[x+1]),l)
yn=MessageBox(hMainWnd,"アドレス "+MakeStr(lanadd)+ex" に\r\nファイル "+MakeStr(filename)+ex" を\r\n送信します。","送信確認",MB_OKCANCEL)
if yn=IDCANCEL then
free(fil)
free(lanadd)
free(filename)
exit sub
end if
'ファイルを読込
filedata=Dataload(fil)
fl=HeapSize(GetProcessHeap(),0,filedata) 'ファイルを取込んだバッファの長さ
'データにファイル名とファイルデータを書き込む
data= HeapAlloc(GetProcessHeap(),HEAP_ZERO_MEMORY,l+fl+1)
memcpy(data,filename,l) '名前
memcpy(VarPtr(data[l+1]),filedata,fl) '&h0 を1個挟んでファイルデータ 注)Makestrでは見れません
IpSend(lanadd,data)
HeapFree(GetProcessHeap(),0,data)
HeapFree(GetProcessHeap(),0,filedata)
free(fil)
free(lanadd)
free(filename)
ptdata(GetDlgItem(hMainWnd,EditBox1),"送信完了")
End Sub
'受信システム-------------------------------------------------------
Function RecvFinal(data as BytePtr) as BytePtr
Dim bkbuf As BytePtr
Dim meml As DWord
Dim hH as HANDLE
hH=GetProcessHeap()
meml=HeapSize(hH,0,data)-1
bkbuf=HeapAlloc(hH,HEAP_ZERO_MEMORY,meml-1) 'バックアップ領域を確保
memcpy(bkbuf,data,meml) '確保した領域に元をコピー
HeapFree(hH,0,data) '元の領域を開放
RecvFinal=bkbuf '元の領域にバックアップをはめ込む
end Function
Function IpRecv(sock as Long) As Long
'Ipよりのファイル受信(データ)
Dim buf As BytePtr
Dim bkbuf As BytePtr
Dim bufl As long
Dim meml As DWord
Dim revl as long
Dim hH as HANDLE
Dim er as long
bufl=8000
hH=GetProcessHeap()
buf =HeapAlloc(hH,HEAP_ZERO_MEMORY,bufl+1)
while -1
'ADText("使用ソケット "+Str$(sock)+ex"\r\n")
revl=recv(sock,buf,bufl,0)
'ADText("受信 "+Str$(revl)+ex" Byte\r\n")
recvcont=recvcont+1
ptdata(GetDlgItem(hMainWnd,EditBox5),"受信 "+Str$(recvcont)+" 回 受信バイト "+Str$(revl)+" Byte")
if revl=SOCKET_ERROR then
er=WSAGetLastError()
if er=WSANOTINITIALISED then 'エラー番号 未開始 10093
_errer(er,"受信")
IpRecv=SOCKET_ERROR
HeapFree(hH,0,buf)
exit Function
end if
ptdata(GetDlgItem(hMainWnd,EditBox1),"受信エラー")
_errer(er,"受信")
_errer(0,"補助")
IpRecv=SOCKET_ERROR
HeapFree(hH,0,buf)
exit Function
Else
meml=HeapSize(hH,0,membuf)-1
bkbuf=HeapAlloc(hH,HEAP_ZERO_MEMORY,meml+revl+1) 'バックアップ領域を確保
memcpy(bkbuf,membuf,meml) '確保した領域に元をコピー
memcpy(VarPtr(bkbuf[meml]),buf,revl) 'さらに受信したものを追加
HeapFree(hH,0,membuf) '元の領域を開放
membuf=bkbuf '元の領域にバックアップをはめ込む
bkbuf=0
End If
exit while
wend
HeapFree(hH,0,buf)
IpRecv=revl
End Function
Sub makedata(data as BytePtr)
'データを名前とデータに分解する
Dim folder as BytePtr 'folder as BytePtr '保存フォルダのフルパス
Dim filename as BytePtr '受信ファイルの名前(非フルパス)
Dim fil as BytePtr 'ファイルのフルパス
Dim filedata as BytePtr 'ファイルを保存する為のポインタ
Dim yn as long 'アンサー変数
Dim fl as long '計算変数
Dim l as long '計算変数
Dim x as long '計算変数
Dim c as long '計算変数
if membuf=0 then exit Sub
folder=gtdata(GetDlgItem(hMainWnd,EditBox2))
'名前を含んだ受信データの長さ
l=HeapSize(GetProcessHeap(),0,data)
if l=0 then exit sub
'受信データからファイル名を書き出す ファイル名 &h0 ファイルのデータ
for x=0 to l-1
if data[x]=&h0 then exit for
next
if x<l-1 then
filename=calloc(x+1)
memcpy(filename,data,x)
end if
'受信データからファイルデータを書き出す
filedata= HeapAlloc(GetProcessHeap(),HEAP_ZERO_MEMORY,l-x-1)
memcpy(filedata,VarPtr(data[x+1]),l-x-1) 'ファイルデータ &h0 を1個挟んでファイルデータ 注)Makestrでは見れません
'ファイルを保存する場所のフルパスを作成する
fl=lstrlen(folder)
fil=calloc(fl+x+2) ' \ の分で+1
memcpy(fil,folder,fl)
memcpy(VarPtr(fil[fl]),"\",1)
memcpy(VarPtr(fil[fl+1]),filename,x)
free(filename)
'yn=MessageBox(hMainWnd,"ファイルパス "+MakeStr(fil)+ex"\r\nファイル\r\n\r\n"+MakeStr(filedata)+ex"\r\n\r\n保存しますか?","保存",MB_OKCANCEL)
yn=MessageBox(hMainWnd,"ファイルパス "+MakeStr(fil)+ex"\r\n\r\n保存しますか?","受信完了 保存",MB_OKCANCEL)
if yn=IDOK then Datasave(GetProcessHeap(),filedata,fil,0)
free(fil)
free(filedata)
if membuf<>0 then
HeapFree(GetProcessHeap(),0,membuf)
membuf=0
end if
end sub
'送信システム---------------------------------------------------------------------
Sub IpSend(lanadd as BytePtr , data as BytePtr)
'指定されたIPアドレス lanadd に
'データ data を送信する。
'Dim wsad As WSADATA
Dim s As SOCKET
Dim send_addr As SOCKADDR_IN
Dim sendbuf as BytePtr
Dim sendbuflong as DWord
Dim sendlong as DWord
Dim buflong as DWord
Dim bufpointer as DWord
Dim x as long
Dim h as long
Dim memlong as DWord
memlong=8000 '一度に送る長さ
'データが揃っているか調査
if lanadd=0 then exit sub
if lstrlen(lanadd)<2 then exit sub
buflong=HeapSize(GetProcessHeap(),0,data)-1
sendbuflong=buflong
sendbuf=HeapAlloc(GetProcessHeap(),HEAP_ZERO_MEMORY,memlong)
'ws2_32.dllを初期化
'If WSAStartup(MAKEWORD(2,0),wsad)=0 Then
'データ長さ確認
If buflong>0 Then
'ソケット生成
s = socket(AF_INET,SOCK_STREAM,0)
'ソケット生成成否
If s<>INVALID_SOCKET Then
'接続情報の準備
send_addr.sin_family = AF_INET
send_addr.sin_port = htons(7)'htons(6824)
send_addr.sin_addr = inet_addr(lanadd) 'サーバーアドレス
'接続と接続成否
If connect(s,send_addr,SizeOf(SOCKADDR_IN))<>SOCKET_ERROR Then
'送信部
bufpointer=0
while bufpointer<buflong
FillMemory(sendbuf,memlong,0)
if sendbuflong<memlong then
HeapFree(GetProcessHeap(),0,sendbuf)
memlong=sendbuflong
sendbuf=HeapAlloc(GetProcessHeap(),HEAP_ZERO_MEMORY,memlong)
end if
memcpy(sendbuf,VarPtr(data[bufpointer]),memlong)
'送信 send <送る内容>,<送る長さ>
sendlong = send(s,sendbuf,memlong,0)
' ADText("送信 "+Str$(bufpointer)+"/"+Str$(buflong)+ex" Byte\r\n")
if sendlong=SOCKET_ERROR then
msgbox 0,"送信エラー","エラー"
_errer(0,"送信")
sendbuflong=buflong
bufpointer=0
Sleep(300)
exit while
'Continue
end if
bufpointer=bufpointer+sendlong
sendbuflong=sendbuflong-sendlong
ptdata(GetDlgItem(hMainWnd,EditBox5),"送信 "+Str$(bufpointer)+"/"+Str$(buflong)+ex" Byte")
wend'memlong
Sleep(500)
'切断
shutdown(s,SD_SEND)
Sleep(500)
shutdown(s,SD_BOTH)
end if
'ソケット破棄
closesocket(s)
End If
End If
'終了処理
' WSACleanup()
'End If
HeapFree(GetProcessHeap(),0,sendbuf)
End Sub
Sub ADText(str As BytePtr)
Dim hw as HWND
Dim limit As DWord
Dim length As DWord
Dim buf As BytePtr
hw=GetDlgItem(hMainWnd,EditBox5)
limit = SendMessage(hw,EM_GETLIMITTEXT,0,0)
length = GetWindowTextLength(hw)
If limit=>length+lstrlen(str) Then
SendMessage(hw,194,0,str)
Else
buf = calloc(length+1+lstrlen(str))
GetWindowText(hw,buf,length+1)
lstrcat(buf,str)
SetWindowText(hw,buf+length+lstrlen(str)-limit)
free(buf)
End If
End Sub
Sub _errer(no as long,t as BytePtr)
Dim lpMsgBuf As BytePtr
if no>0 then
'エラー詳細
FormatMessage(FORMAT_MESSAGE_ALLOCATE_BUFFER or FORMAT_MESSAGE_FROM_SYSTEM or FORMAT_MESSAGE_IGNORE_INSERTS, _
NULL, _
no, _
LANG_USER_DEFAULT, _
VarPtr(lpMsgBuf), _
0, _
NULL)
MessageBox(0,lpMsgBuf,MakeStr(t)+" Error メッセージ "+Str$(no),MB_OK)
LocalFree(lpMsgBuf)
exit sub
end if
'エラー詳細
FormatMessage(FORMAT_MESSAGE_ALLOCATE_BUFFER or FORMAT_MESSAGE_FROM_SYSTEM or FORMAT_MESSAGE_IGNORE_INSERTS, _
NULL, _
WSAGetLastError(), _
LANG_USER_DEFAULT, _
VarPtr(lpMsgBuf), _
0, _
NULL)
MessageBox(0,lpMsgBuf,MakeStr(t)+" Error メッセージ",MB_OK)
LocalFree(lpMsgBuf)
End Sub
[/code]