ab.com コミュニティ

コード: 全て選択

'-----------------------------------------------------------------------------
'  イベント プロシージャ
'-----------------------------------------------------------------------------
' このファイルには、ウィンドウ [MainWnd] に関するイベントをコーディングします。
' ウィンドウ ハンドル: hMainWnd

'ネット関係
Declare Function InternetOpen Lib "wininet.dll" Alias "InternetOpenA" (ByVal sAgent As BytePtr,_
	ByVal lAccessType As Long, ByVal sProxyName As BytePtr,ByVal sProxyBypass As BytePtr,_
	ByVal lFlags As Long) As Long
Declare Function InternetOpenUrl Lib "wininet.dll" Alias "InternetOpenUrlA" (ByVal hInternetSession As Long,_
	ByVal sUrl As BytePtr,ByVal sHeaders As BytePtr, ByVal lHeadersLength As Long, _
	ByVal lFlags As Long, ByVal lContext As Long) As Long
Declare Function InternetReadFile Lib "wininet.dll" (ByVal hFile As Long, ByVal sBuffer As BytePtr,_
	ByVal lNumBytesToRead As Long,lNumberOfBytesRead As Long) As Integer
Declare Function InternetCloseHandle Lib "wininet.dll" (ByVal hInet As Long) As Integer

'行のカウント
Function EditBox_GetLineCount(ByVal hWnd As HWND)
    EditBox_GetLineCount=SendMessage(hWnd,EM_GETLINECOUNT,NULL,NULL)
End Function

'1行の取得
Function EditBox_GetLine(ByVal hWnd As HWND,ByVal nIndex As Long) As BytePtr
Dim length[2] As Long
    'nIndex が全体の何バイト目なのかを格納。
    length[0]=SendMessage(hWnd,EM_LINEINDEX,nIndex,NULL)

    If length[0]<>-1 Then
        'nIndex の次の行が全体の何バイト目なのかを格納。
        length[1]=SendMessage(hWnd,EM_LINEINDEX,nIndex+1,NULL)
        If length[1]<>-1 Then
            'nIndex のバイト数を格納。
            length[2]=length[1]-length[0]
        Else
            'nIndex のバイト数を格納。
            length[2]=GetWindowTextLength(hWnd)-length[0]
        End If
    End If

    EditBox_GetLine=calloc(length[2]+1)
    If length[2] Then
        SetWord(EditBox_GetLine,length[2]+1)
        EditBox_GetLine[SendMessage(hWnd,EM_GETLINE,nIndex,EditBox_GetLine)]=0
    End If
End Function


'-----------------------------------------------------------------------------
' ウィンドウメッセージを処理するためのコールバック関数

Function MainWndProc(hWnd As HWND, dwMsg As DWord, wParam As WPARAM, lParam As LPARAM) As DWord
	' TODO: この位置にウィンドウメッセージを処理するためのコードを記述します。

	' イベントプロシージャの呼び出しを行います。
	MainWndProc=EventCall_MainWnd(hWnd,dwMsg,wParam,lParam)
End Function


'-----------------------------------------------------------------------------
' ここから下は、イベントプロシージャを記述するための領域になります。

Sub MainWnd_Destroy()
	net_DestroyObjects()
	PostQuitMessage(0)
End Sub

'netの処理
Sub MainWnd_CommandButton1_Click()

	Dim hEdit As HWND
	Dim cnt As Long
	Dim address As BytePtr
	Dim buf As String
	Dim html As String
	Dim length As Long, open As Long, bufSize As Long, url As Long
	Dim strBuf As String
		
		 hEdit=GetDlgItem(hMainWnd,EditBox1)
		 For cnt=1 To EditBox_GetLineCount(hEdit)
	     address=EditBox_GetLine(hEdit,cnt)
		 length=48'Len(MakeStr(address))+1
	   	address=calloc(length+2)'+2はダブルコーテーションの為
    	GetWindowText(hEdit,address,length)

	buf=ZeroString(1001)
	open=InternetOpen(0,0,0,0,0)
	If open=NULL Then 
	Exit Function
	End If
	
	url=InternetOpenUrl(open,address,0,0,0,0)
	If url=NULL Then
		InternetCloseHandle(open)
		Exit Function
	End If
	bufSize=Len(buf)
'	free(address)

Do
	InternetReadFile(url,buf,1000,VarPtr(bufSize))
	html=html+Left$(buf,InStr(1,buf,Chr$(0))-1)
Loop While bufSize<>0
InternetCloseHandle(open)

	strBuf=strBuf+MakeStr(address)+Ex"\r\n"
	free(address)
	Next

SetWindowText(GetDlgItem(hMainWnd,EditBox2),strBuf)

End Sub

コード: 全て選択

Declare Function InternetReadFile Lib "wininet" (
    ByVal hFile As HINTERNET,
    ByVal sBuffer As BytePtr,
    ByVal lNumBytesToRead As DWord,
    ByVal lNumberOfBytesRead As DWORD_PTR) As BOOL

		↑
		↓

Declare Function InternetReadFile Lib "wininet.dll" (
    ByVal hFile As Long,
    ByVal sBuffer As BytePtr,
    ByVal lNumBytesToRead As Long,
    lNumberOfBytesRead As Long) As Integer

コード: 全て選択

Sub MainWnd_Destroy()
	test_DestroyObjects()
	'ウィンドウが破棄される時
	DeleteObject(hBitmap)
	PostQuitMessage(0)
End Sub

コード: 全て選択

Sub MainWnd_CommandButton1_Click()
'途中省略
　　　　：
'EditBox2へ出力
    SetWindowText(GetDlgItem(hMainWnd,EditBox2),strBuf)
End Sub

Sub MainWnd_CommandButton2_Click()

SetClipboardText(hMainWnd,strBuf)

End Sub

コード: 全て選択

'HBITMAP型グローバル変数 hBitmap の宣言
Dim hBitmap As HBITMAP

'ウィンドウが作られた時
hBitmap=LoadImage(GetModuleHandle(0),IDB_BITMAP1,IMAGE_BITMAP,0,0,LR_DEFAULTSIZE)
SendDlgItemMessage(hMainWnd,CommandButton1,BM_SETIMAGE,IMAGE_BITMAP,hBitmap)

'ウィンドウが破棄される時
DeleteObject(hBitmap)

コード: 全て選択

 Function SetClipboardText(ByVal hWnd As HWND,ByVal lpString As BytePtr) As BOOL
Dim hMem As HGLOBAL
Dim lpStr As BytePtr
    SetClipboardText=FALSE
    hMem=GlobalAlloc(GMEM_DDESHARE or GHND,lstrlen(lpString)+1)
    If hMem Then
        lpStr=GlobalLock(hMem)
        If lpStr Then
            lstrcpy(lpStr,lpString)
            GlobalUnlock(hMem)
            If OpenClipboard(hWnd) Then
                EmptyClipboard()
                SetClipboardData(CF_TEXT,hMem)
                CloseClipboard()
                SetClipboardText=TRUE
            End If
        End If
        GlobalFree(hMem)
    End If
End Function

'使い方
SetClipboardText(hMainWnd,"SetClipboardText()関数")