ab.com コミュニティ

ActiveBasicを通したコミュニケーション
現在時刻 - 2024年3月28日(木) 22:06

全ての表示時間は UTC+09:00 です




新しいトピックを投稿する  トピックへ返信する  [ 6 件の記事 ] 
作成者 メッセージ
投稿記事Posted: 2010年1月12日(火) 13:16 
明けましておめでとうございます。

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]


通報する
ページトップ
   
 記事の件名: 使用
投稿記事Posted: 2010年1月12日(火) 13:20 
すいません。下記忘れました。
XPSP3 AB4.24を使用しています。


通報する
ページトップ
   
 記事の件名:
投稿記事Posted: 2010年1月13日(水) 00:16 
自分で気が付いたような気がします。
まだ試していませんが、
受信側は非同期なのに送信側はそうでないですね。

送信が終了した直後にソケットを閉じる上に
受信側はSD_SENDなりSD_BOTHを受け取り
ソケットを閉じてしまうけどデータが残っているので
recvを実行するがソケットが閉じられているので
アクセスが拒否されたとなるのかな・・・?
なんかその辺が悪い気がします。
書き込んだ後に気付く事が多くてすいません。
勉強している本を読み直して気が付きました。
上手く行きましたらご報告します。


通報する
ページトップ
   
 記事の件名: 解決
投稿記事Posted: 2010年1月13日(水) 21:48 
お騒がせしました。
解決しました。

FD_CLOSEの処理にあたり
closesocket前に受信バッファを空に出来ていませんでした。
read命令>ブロック解除>まだ受信バッファが残ってる>
でも仮想回路では受信終了>FD_CLOSE>closesocket>
ブロック解除されて受信バッファが残ってるので>FD_READ>
ソケットありませんぜ旦那!!>エラーでした。
ちゃんと理解してるつもりが出来ていないのですねぇ。。
バッファが無くなるまでFD_CLOSEは来ないと思っていました。
では、また壁にぶち当たって心がくじけそうになったらお邪魔します。

ps:やっぱりSendMessageの194がわかりません。
謎です。。どなたか、なんの指示なのか教えてくれませんでしょうか。。
WM_SETTEXTの類だと思うのですがWM_SETTEXTは12でしたし・・・謎!


通報する
ページトップ
   
 記事の件名:
投稿記事Posted: 2010年1月13日(水) 23:47 
オフライン

登録日時: 2005年5月31日(火) 07:49
記事: 162
> ps:やっぱりSendMessageの194がわかりません。
> 謎です。。どなたか、なんの指示なのか教えてくれませんでしょうか。。
> WM_SETTEXTの類だと思うのですがWM_SETTEXTは12でしたし・・・謎!

EM_REPLACESEL メッセージ、テキストの選択部分を lParam 引数で指定した文字列で置き換えるメッセージらしいです。


# じつは何とかご協力しようとコード追いかけてたのですが、先に解決されちゃいました。
# こういうところだけにしか回答できないのは我ながら何とも情けない・・・精進せねば


通報する
ページトップ
投稿記事Posted: 2010年1月14日(木) 15:23 
>>takさん

お騒がせした上にご指導まで頂いて
貴重な時間を割いてコードを追いかけてまでくれて
本当にありがとうございます!

EM_REPLACESEL の件、めっちゃすっきりしました!
何かと何かを混ぜたような処理なのかなぁと憶測とかしてのですが
EM_だったんですね><;
まだまだ勉強不足です。
winsockがもうちょっと片付いたら今度はコモンコントロールに
足を突っ込もうとがんばってます!
またお世話になるやもしれませんが、お暇がありましたら相手をしてやってください。
本当にありがとうございました!


通報する
ページトップ
   
期間内表示:  ソート  
新しいトピックを投稿する  トピックへ返信する  [ 6 件の記事 ] 

全ての表示時間は UTC+09:00 です


オンラインデータ

このフォーラムを閲覧中のユーザー: なし & ゲスト[9人]


トピック投稿:  可
返信投稿:  可
記事編集: 不可
記事削除: 不可
ファイル添付: 不可

検索:
ページ移動:  
Powered by phpBB® Forum Software © phpBB Limited
Japanese translation principally by ocean