出来るのだＡＳＰ Ｑ＆Ａ掲示板（過去ＬＯＧ） 　訪問数 52046 昨日 889 今日 776
     【PR】 パソコン入門からIT専門書まで幅広く取り揃えています。セブン-イレブン受取り手数料無料のセブンアンドワイ。
Topに戻る 掲示板に戻る 検索 削除 管理者
汎用関数とか投函してみませんか？ 　 ビギナーズラックさん [2005/11/30 12:59:52] [5496]
　 Re:汎用関数とか投函してみませんか？ 　 YasNet（管理人）さん [2005/12/01 12:08:01] [5498]
　 　 Re:汎用関数とか投函してみませんか？ 　 YasNet（管理人）さん [2005/12/03 17:52:48] [5503]
　 　 　 Re:汎用関数とか投函してみませんか？ 　 YasNet（管理人）さん [2005/12/30 18:14:07] [5563]
　 Re:汎用関数とか投函してみませんか？ 　 ビギナーズラックさん [2005/12/03 20:54:26] [5504]
　 　 Re:汎用関数とか投函してみませんか？ 　 ビギナーズラックさん [2005/12/15 1:39:51] [5524]
　 Re:汎用関数とか投函してみませんか？ 　 ビギナーズラックさん [2005/12/03 20:57:01] [5505]
　 Re:汎用関数とか投函してみませんか？ 　 ビギナーズラックさん [2005/12/03 21:05:19] [5506]
[5496] 汎用関数とか投函してみませんか？
投稿者：ビギナーズラックさん 2005/11/30 12:59:52
ASPでいろいろサイト作ってると毎度つれて歩いてる汎用Functionとかたまってくるじゃないですか？
そんなの投函してみませんか？
他のプロの方がどんなの持ち歩いてるか興味あります。

とりあえずこんなんどうでしょ？(w

Function vbDMaxinEx(intMode, cn, TableName, FieldName , WhereCondition)
'**************************************
'ADO版指定したフィールドの最大値+1(最小値)を求める
'最大値は+1にしたのでちょっと注意
'cn --- コネクション
'TableName --- テーブル名
'FieldName --- フィールド名
'**************************************
On Error Resume next

Dim TempMaxRs
Dim strSQL
Set TempMaxRs = Server.CreateObject("ADODB.Recordset")

Select Case intMode
Case 1 '最大
strSQL = "SELECT * FROM " & TableName & " WHERE(" & WhereCondition & ") ORDER BY " & TableName & "." & FieldName & " DESC;"
Case 2 '最小
strSQL = "SELECT * FROM " & TableName & " WHERE(" & WhereCondition & ") ORDER BY " & TableName & "." & FieldName & " ;"
End Select

TempMaxRs.Open strSQL, cn,2,4
'何もない場合は1とする
If TempMaxRs.EOF Then
vbDMaxinEx = 1
TempMaxRs.Close
set TempMaxRs = Nothing
Exit Function
End If

TempMaxRs.MoveFirst

Select Case intMode
Case 1
vbDMaxinEx = clng(TempMaxRs.Fields(FieldName))+1
Case 2
vbDMaxinEx = clng(TempMaxRs.Fields(FieldName))
End Select

TempMaxRs.Close
set TempMaxRs = Nothing

End Function
[5498] Re:汎用関数とか投函してみませんか？
投稿者：YasNet（管理人）さん 2005/12/01 12:08:01
こんにちは　YasNet（管理人）です。

> Functionとかたまってくるじゃないですか？
> そんなの投函してみませんか？

盛り上げていただき、有難う御座います。
この掲示板では、何れ埋もれてしまうので

ちょっと別の掲示板の立ち上げを検討します。

現在客先の為、出来るだけ今週土曜日に対応がんばってみます。
掲示板のタイプは
このタイプで使いやすいかな？

それでは　失礼致します。
[5503] Re:汎用関数とか投函してみませんか？
投稿者：YasNet（管理人）さん 2005/12/03 17:52:48
こんにちは　YasNet（管理人）です。

すみません、時間が取れませんでした。
もう少し時間がかかりそうですので
このスレッドに追加していってください。

専用投稿場所が出来ればそちらへ移行します。

それでは　失礼致します。
[5563] Re:汎用関数とか投函してみませんか？
投稿者：YasNet（管理人）さん 2005/12/30 18:14:07
こんにちは　YasNet（管理人）です。

ふ〜、なんとか無理やり年内に公開出来ました。
とは、言えソースがキ、キタナイ

簡単なテストは完了しているのですが
もし、動作がおかしいところを発見した場合は連絡頂ければ幸いです。

もう少し、コード整理できればこの掲示板も置き換えます。・・・いつ出来るやら

それでは　失礼致します。
[5504] Re:汎用関数とか投函してみませんか？
投稿者：ビギナーズラックさん 2005/12/03 20:54:26
> ASPでいろいろサイト作ってると毎度つれて歩いてる汎用Functionとかたまってくるじゃないですか？
> そんなの投函してみませんか？
> 他のプロの方がどんなの持ち歩いてるか興味あります。
>

とりあえず超基本のメール送信モジュール


Function MailSendCDO(logfile,smtp,strTo,strFrom,strSub,strMsg)
On error Resume Next

Set objEmail = CreateObject("CDO.Message")
With objEmail
.From = "<" & strfrom & ">"
.To = "<" & strto & ">"
.Subject = strSub
.Textbody = strMsg
.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") =smtp
.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
.Configuration.Fields.Update
.Send
End With
MailSendCDO=Err.Number
Set objEmail=Nothing

End Function

BASP21で送信しているサイトって結構あると思いますが
安定度ではCDOで送信する方が遙かに上です。(経験済み)
[5524] Re:汎用関数とか投函してみませんか？
投稿者：ビギナーズラックさん 2005/12/15 1:39:51
個人的には.NET推進派なのでVB.NET版の送信モジュールも

Function SendMailEx(ByVal strSMTP As String, ByVal strTo As String, ByVal strFrom As String, ByVal strSub As String, ByVal strMsg As String, ByVal strXMailer As String) As Boolean
'********************
'VB.NET版メール送信
'********************
Dim objMsg As New System.Web.Mail.MailMessage

Try

objMsg.BodyEncoding = System.Text.Encoding.GetEncoding("iso-2022-jp")
objMsg.BodyFormat = Web.Mail.MailFormat.Text
objMsg.Priority = Web.Mail.MailPriority.Normal
objMsg.From = strFrom
objMsg.To = strTo
objMsg.Subject = strSub
objMsg.Body = strMsg
objMsg.Headers.Add("X-Mailer", strXMailer)

System.Web.Mail.SmtpMail.SmtpServer = strSMTP
System.Web.Mail.SmtpMail.Send(objMsg)

Return False

Catch ex As Exception
Return True
Finally
objMsg = Nothing
End Try

End Function
[5505] Re:汎用関数とか投函してみませんか？
投稿者：ビギナーズラックさん 2005/12/03 20:57:01
> ASPでいろいろサイト作ってると毎度つれて歩いてる汎用Functionとかたまってくるじゃないですか？
> そんなの投函してみませんか？
> 他のプロの方がどんなの持ち歩いてるか興味あります。
>

絶対にいるのがnullチェック

Function vbNz(varDat, alias)
'********************
'VBS版nz関数
'********************
On Error Resume next

If IsNull(varDat) Or varDat = "" Then
vbNz = alias
Else
vbNz = varDat
End If

End Function
[5506] Re:汎用関数とか投函してみませんか？
投稿者：ビギナーズラックさん 2005/12/03 21:05:19
> ASPでいろいろサイト作ってると毎度つれて歩いてる汎用Functionとかたまってくるじゃないですか？
> そんなの投函してみませんか？
> 他のプロの方がどんなの持ち歩いてるか興味あります。
>

めんどくさいのでまとめてコピー(w

Function FileExistCheck(sFileName)
'*************************************************
'指定したパスにファイルが存在するかチェックする
'以下のどちらでも指定可能
'img/test.jpg
'c:\Inetpub\www\img\test.jpg
'戻り値 1エラー 0存在する
'*************************************************

On Error Resume Next

Dim objFSOCheck
Dim objTSCheck

Set objFSOCheck = CreateObject("Scripting.FileSystemObject")

If instr(1,sFileName,"\")<>0 then
Set objTSCheck = objFSOCheck.GetFile(sFileName)
Else
Set objTSCheck = objFSOCheck.GetFile(Server.MapPath(sFileName))
End If

If err.number <>0 then
FileExistCheck=1
Else
FileExistCheck=0
End If

Set objTSCheck = Nothing
Set objFSOCheck = Nothing

End Function


Function ExecAppWSH(apppath,param)
'*******************************************
'非表示でサーバの外部プログラム実行
'戻り値 0が正常
'*******************************************

On error resume next

Dim objWshShell
Set objWshShell=Server.CreateObject("WScript.Shell")

ExecAppWSH=objWshShell.Run(apppath & " " & param, 0, 1)

Set objWshShell = Nothing

End Function

Function vbCopy(moto,saki,intmode)
'*******************************************
'moto ---コピー元ファイルパス
'saki ---コピー先ファイルパス
'intMode ---モード
'1 ---> 移動 / 2---> コピー
'*******************************************
On Error Resume Next

Dim Fso
Dim CopyRtn

'ファイルのコピー
Set Fso = CreateObject("Scripting.FileSystemObject")

Select Case intmode
Case 1
CopyRtn=Fso.MoveFile(moto, saki)
Case 2
CopyRtn=Fso.CopyFile(moto, saki, TRUE)'上書許可TRUE/FALSE
Case Else
CopyRtn=Fso.MoveFile(moto, saki)

End Select

vbCopy=CopyRtn

Set Fso = Nothing


End Function

Function vbDelete(moto)
'*******************************************
'moto ---強制削除ファイルパス
'*******************************************
On Error Resume Next

Dim Fso
Dim CopyRtn


Set Fso = CreateObject("Scripting.FileSystemObject")

CopyRtn=Fso.DeleteFile(moto, true)

vbDelete=CopyRtn

Set Fso = Nothing

End Function


Function CheckData(str,pattern)
'**********************************
'入力されたデータをチェックする
'引数 str pattern
'戻り値 TRUE OK False NG
'**********************************
On error resume next

Set re = New RegExp

re.Pattern =pattern
re.Global = True
re.IgnoreCase = True
CheckData=re.Test(str)

End Function



Function EndCutString(strCut,strCheck)
'**********************************
'strCutのstrCheckより後の文字を返す
'test@docomo.ne.jp →@指定時 docomo.ne.jp
'**********************************
On Error Resume next

Dim tmpStrCnt
Dim strtmpCut

tmpStrCnt = InStr(1, strCut, strCheck)
If tmpStrCnt<>0 Then
strtmpCut = Mid(strCut, tmpStrCnt + 1)
Else
EndCutString=-1
Exit Function
End If
EndCutString = strtmpCut

End Function

Function FirstCutString(strCut,strCheck)
'**********************************
'strCutのstrCheckより前の文字を返す
'test@docomo.ne.jp →@指定時 test
'**********************************
On Error Resume next

Dim tmpStrCnt
Dim strtmpCut

tmpStrCnt = InStr(1, strCut, strCheck)

If tmpStrCnt<>0 Then
strtmpCut = left(strCut, tmpStrCnt - 1)
Else
FirstCutString=-1
Exit Function
End If
FirstCutString = strtmpCut

End Function

TreeBBS For ASP V.0.1.3
Program By ＹａｓＮｅｔ