Option Explicit

'*************************************************************
'ロード時
Sub Window_onLoad


End Sub

'*************************************************************
'初期処理
Sub Calc(intType)

	Dim a
	Dim s
	Dim Output
	Dim lngFee
	Dim dblRate
	Dim intMinFee
	Dim objTxt


	Select Case intType
	case 0
		a = frm.txtOrix.Value
		dblRate = 0.000945
		Set objTxt = frm.txtOrix
		intMinFee = 315
	case 1
		a = frm1.txtMarusan.Value
		dblRate = 0.00105
		Set objTxt = frm1.txtMarusan
		intMinFee = 1050
	case 2
		a = frm2.txtMonex.Value
		dblRate = 0.001575
		Set objTxt = frm2.txtMonex
		intMinFee = 1575
	End Select


	If IsNumeric(a) = False then
		Msgbox "売買金額が正しく入力されていません",16,"エラー"
		Exit Sub
	End If

	lngFee = a * dblRate

	If lngFee <= intMinFee Then
		lngFee = intMinFee
	End If	

	lngFee = FormatNumber(lngFee,0,0,0,0)

	objTxt.value = lngFee
	

End Sub

'手数料計算
Function fnint_CalcFee(intGaku)





End Function

'*************************************************************
'手数料計算
Function fnGetFee(intGaku)

    Const dbSystemObject = &H80000002
    Const dbHiddenObject = &H1
    Dim dbe, db, tdfs, atr, i, s
	Dim dbPath
	Dim rstData
	Dim rstData2

	Dim iTmp
	Dim strTmp

	Dim intPlan 
	Dim strSQL
	Dim strCorpName 
	Dim strCorps()
	Dim intFee()

	Dim strCorps2()
	Dim intFee2()
	Dim strURL()
	Dim intCorpID() 
	Dim intCorpNum 
	Dim j
	Dim k
	Dim intMinFee



	If frm.fee(0).checked = True Then
		intPlan = 0
	Else
		intPlan = 1
	End If

	dbPath = window.location.pathname
	dbPath = Left(dbPath,InstrRev(dbPath,"\")-1)
	dbPath = dbPath & "\fee.mdb"
	
	If left(dbPath,1) = "/" then
		dbPath = Right(dbPath,Len(dbPath)-1)
	End If



	'Msgbox strSQL

'**************
    ' オブジェクト変数に参照をセットします。
    Set dbe = CreateObject("DAO.DBEngine.36")

	Mggbox "a"

    ' 共有モードでデータベースを開きます。
    Set db = dbe.Workspaces(0).OpenDatabase(dbPath, False)


'会社IDの一覧を取得
	Set rstData = db.OpenRecordset("SELECT DISTINCT(CorpID) FROM fee WHERE feetype = " & intPlan) 
	rstData.MoveLast
	rstData.MoveFirst
	i=1
	Do While Not rstData.EOF
		Redim Preserve intCorpID(i)
		intCorpID(i) = rstData.Fields(0).value
		i=i+1
		rstData.MoveNext
	Loop
	
	Set rstData = Nothing
	intCorpNum = i-1

	j=1

	For i=1 To intCorpNum

		strSQL = "SELECT * FROM fee WHERE feetype = " & intPlan & " AND CorpID = " & intCorpID(i) & " ORDER BY Kabuka"
	    Set rstData = db.OpenRecordset(strSQL)
	
		rstData.MoveLast
		rstData.MoveFirst
	
		Do While Not rstData.EOF
			
			If CLng(intGaku) <= CLng(rstData.Fields("kabuka").value) Then
				
				Set rstData2 = db.OpenRecordset("SELECT * FROM Corp WHERE CorpID = " & intCorpID(i))
				strCorpName = rstData2.Fields("CorpName").value
				intMinFee = rstData2.Fields("MinFee").value
				

				Redim Preserve strCorps(j)
				Redim Preserve intFee(j)
				Redim Preserve strURL(j)
				strCorps(j) = strCorpName
				strURL(j) = rstData2.Fields("URL").value

				Set rstData2 = Nothing
				
				'%で計算の場合
				If rstData.Fields("RateFlg").value = False Then
					intFee(j) = rstData.Fields("fee").value
				Else
					intFee(j) = CLng(intGaku * rstData.Fields("fee").value)
					if intMinFee <> 0 Then
						if intFee(j) < intMinFee Then
							intFee(j) = intMinFee
						End If
					End If
				End If

				j=j+1
	
				Exit Do
			End If
	
			rstData.MoveNext
		Loop

		Set rstData = Nothing

	Next

	intCorpNum = j-1

'安い順にソート


    For i = 1 To intCorpNum - 1
    
        If intFee(i) <= intFee(i + 1) Then
        Else
            iTmp = intFee(i)
            intFee(i) = intFee(i + 1)
            intFee(i + 1) = iTmp
			
			strTmp = strCorps(i)
			strCorps(i) = strCorps(i+1)
			strCorps(i+1) = strTmp
			
			strTmp = strURL(i)
			strURL(i) = strURL(i+1)
			strURL(i+1) = strTmp

            i = 0
        End If

    Next 

	s = s & "<TABLE cellspacing=""0"">"		
	s = s & "<COL span=""1"" width=""50"" align=""center"">"
	s = s & "<COL span=""1"" width=""100"" align=""left"">"
	s = s & "<COL span=""1"" width=""80"" align=""right"">"

	s = s & "<TR bgcolor=beige>"
	s = s & "<TD>　</TD><TD align=""center"">証券会社</TD><TD>手数料</TD>"		
	s = s & "</TR>"

	For i=1 To j-1
	
		s = s & "<TR>"
		s = s & "<TD>" & i & "</TD><TD><A HREF = " & strURL(i)  & " target=""_blank""" & ">" & strCorps(i) & "</A></TD><TD>" & intFee(i) & "円</TD>"		
		s = s & "</TR>"
	Next

	s = s & "</TABLE>"

    ' オブジェクト変数の参照を解放します。
    'Set tdfs = Nothing
	Set rstData = Nothing
    db.Close: Set db = Nothing
    Set dbe = Nothing
'**************

	objList.innerHTML = s   ' ブラウザに出力します。

End Function

'*************************************************************
'Dir関数
Function Dir(strFileName)
 	Dim objFSO  ' FileSystemObject 格納用
  
  	' FileSystemObject生成
  	Set objFSO = CreateObject("Scripting.FileSystemObject")
  
  	' ファイルの存在確認
  	Select Case objFSO.FileExists(strFileName)
    
    Case True:  Dir = strFileName
    Case False: Dir = ""
    
  	End Select
  
  	' オブジェクト破棄
 	 Set objFSO = Nothing

End Function