%
Function GeneratePW(PWlength)
Dim data
data = "abcdefghijkmnpqrstuvwxyz2345678923456789"
GeneratePW = ""
Randomize
for i = 1 to PWlength
GeneratePW = GeneratePW & Mid(data, Round(Rnd()*40+0.5), 1)
Next
End Function
Function GenerateID
GenerateID = CStr(Hex(Minute(Now)*60+Second(Now)))
GenerateID = String(3-Len(GenerateID), "0")&GenerateID
GenerateID = CStr(Hex(Month(Now)*744+Day(Now)*24+Hour(Now)))&GenerateID
GenerateID = String(7-Len(GenerateID), "0")&GenerateID
GenerateID = Right(CStr(Year(Now)), 1)&GenerateID
End Function
Function Text2HTML(text)
buffer = text
buffer = Replace(buffer, " < "," < ")
buffer = Replace(buffer, " > "," > ")
i = 1
Do
j = InStr(i, buffer,">")
k = InStr(i, buffer, "<")
If j = 0 Then
buffer = Left(buffer, i-1)&Replace(buffer, "<", "<", i)
Exit Do
ElseIf k = 0 Then
buffer = Left(buffer, i-1)&Replace(buffer, ">", ">", i)
Exit Do
ElseIf j < k Then
buffer = Left(buffer, i-1)&Replace(buffer, ">", ">", i, 1)
ElseIf (InStr(k+1, buffer, "<") > 0) And (InStr(k+1, buffer, "<") < j) Then
buffer = Left(buffer, i-1)&Replace(buffer, "<", "<", i, 1)
Else
i = j+1
End If
Loop
i = 0
Do
i = InStr(i+1, buffer,"<")
j = InStr(i+1, buffer, ">")
If i = 0 Then
Exit Do
ElseIf i < j Then
Do
k = InStr(i, buffer, vbNewLine)
If (k = 0) Or (k > j) Then
Exit Do
Else
buffer = Left(buffer, k-1)&Replace(buffer, vbNewLine, "", k)
End If
Loop
End If
Loop
i = -1
Do While i <> 1
i = InStrRev(buffer, vbNewLine, i)
j = InStr(i+Len(vbNewLine), buffer, vbNewLine)
If j = 0 Then j = Len(buffer)
If i = 0 Then
i = 1
k = 1
Else
k = i+Len(vbNewLine)
End If
If j-k > 0 Then
If InStr(k, buffer, ">") = k Then
If i = 1 Then
buffer = ""&Left(buffer, j-1)&""&Mid(buffer, j)
Else
buffer = Left(buffer, k-1)&""&Mid(buffer, k, j-k)&""&Mid(buffer, j)
End If
Else
Do
j1 = InStrRev(LCase(buffer), "http://", j)
j2 = InStrRev(LCase(buffer), "ftp://", j)
If (j1 < i) And (j2 < i) Then
Exit Do
Else
If (j1 > j2) Then
j = j1
strTemp = "http://"
Else
j = j2
strTemp = "ftp://"
End If
End If
k = j
Do While (k > i)
CharCode = Asc(Mid(buffer, k))
If (CharCode < 0) Or (CharCode >= 127) Or (CharCode = 60) Then
Exit Do
Else
k = k -1
End If
Loop
If (InStr(Mid(buffer, k, j-k), "<") = 0) Or ((InStr(Mid(buffer, k, j-k), "<") > 0) And (InStr(Mid(buffer, k, j-k), ">") > 0) And (InStr(Mid(LCase(buffer), k, j-k), strTemp) = 0)) Then
k = j
Do
If k = Len(buffer)+1 Then Exit Do
CharCode = Asc(Mid(buffer, k))
If (CharCode <= 32) Or (CharCode = 34) Or (CharCode = 60) Or (CharCode >= 127) Then Exit Do
k = k+1
Loop
buffer = Left(buffer, j-1)&""&Mid(buffer, j, k-j)&""&Mid(buffer, k)
End If
Loop
End If
End If
Loop
i = -1
Do
i = InStrRev(buffer, "&", i)
If i = 0 Then
Exit Do
Else
j = InStr(i, buffer, "<")
k = InStr(i, buffer, ">")
If ((j = 0) And (k = 0)) Or ((j > 0) And (j < k)) Then
If (InStr(i, buffer, ">") <> i) And (InStr(i, buffer, "<") <> i) Then
buffer = Left(buffer, i-1)&Replace(buffer, "&", "&", i, 1)
End If
End If
If i = 1 Then
Exit Do
Else
i = i-1
End If
End If
Loop
i = -1
Do
i = InStrRev(buffer, Chr(34), i)
If i = 0 Then
Exit Do
Else
j = InStr(i, buffer, "<")
k = InStr(i, buffer, ">")
If ((j = 0) And (k = 0)) Or ((j > 0) And (j < k)) Then
buffer = Left(buffer, i-1)&Replace(buffer, Chr(34), """, i, 1)
End If
If i = 1 Then
Exit Do
Else
i = i-1
End If
End If
Loop
i = -1
Do
i = InStrRev(buffer, " ", i)
If i = 0 Then
Exit Do
Else
j = InStr(i, buffer, "<")
k = InStr(i, buffer, ">")
If ((j = 0) And (k = 0)) Or ((j > 0) And (j < k)) Then
If i = 1 Then
buffer = Left(buffer, i-1)&Replace(buffer, " ", " ", i, 1)
ElseIf (Mid(buffer, i-1, 1)=" ") Or (Mid(buffer, i-1, 1)=Chr(10)) Or (Mid(buffer, i-1, 1)=Chr(13)) Or (Mid(buffer, i+1, 6)=" ") Then
buffer = Left(buffer, i-1)&Replace(buffer, " ", " ", i, 1)
End If
End If
If i = 1 Then
Exit Do
Else
i = i-1
End If
End If
Loop
i = -1
Do
i = InStrRev(buffer, Chr(9), i)
If i = 0 Then
Exit Do
Else
j = InStr(i, buffer, "<")
k = InStr(i, buffer, ">")
If ((j = 0) And (k = 0)) Or ((j > 0) And (j < k)) Then
buffer = Left(buffer, i-1)&Replace(buffer, Chr(9), " ", i, 1)
End If
If i = 1 Then
Exit Do
Else
i = i-1
End If
End If
Loop
buffer = Replace(buffer, vbNewLine, "
")
Text2HTML = buffer
End Function
Function HTML2Text(HTML)
Buffer = HTML
Buffer = Replace(Buffer, "
", vbNewLine)
strTemp = ""
i = 1
Do
j = InStr(i, Buffer, "<")
k = InStr(j+1, Buffer, ">")
If (j > 0) And (k > 0) Then
strTemp = strTemp & Mid(Buffer, i, j-i)
i = k+1
Else
strTemp = strTemp & Mid(Buffer, i)
Exit Do
End If
Loop
Buffer = strTemp
Buffer = Replace(Buffer, "<", "<")
Buffer = Replace(Buffer, ">", ">")
Buffer = Replace(Buffer, " ", " ")
Buffer = Replace(Buffer, """, Chr(34))
Buffer = Replace(Buffer, "&", "&")
HTML2Text = Buffer
End Function
%>
日本進化学会第20回大会会参加申込み
日本進化学会第20回大会参加申込みは8月17日をもって終了いたしました。 参加ご希望の方は、当日、会場にて参加申込を受付けいたします。 |