代码： 全选
''
'' simple http-get example for both Windows and Linux
''
#ifdef __FB_WIN32__
#include once "win/winsock2.bi"
#else
#include once "crt/netdb.bi"
#include once "crt/sys/socket.bi"
#include once "crt/netinet/in.bi"
#include once "crt/arpa/inet.bi"
#include once "crt/unistd.bi"
#endif
const RECVBUFFLEN = 8192
const NEWLINE = !"\r\n"
const CONTENTSTART = !"\r\n\r\n"
declare sub doInit
declare sub doShutdown
declare sub getHostAndPath _
( _
byref src as string, _
byref hostname as string, _
byref path as string _
)
declare function resolveHost _
( _
byref hostname as string _
) as integer
declare sub reportError _
( _
byref msg as string _
)
sub getHostAndPath _
( _
byref src as string, _
byref hostname as string, _
byref path as string _
)
dim p as integer
p = instr( src, " " )
if( p = 0 or p = len( src ) ) then
hostname = trim( src )
path = ""
else
hostname = trim( left( src, p-1 ) )
path = trim( mid( src, p+1 ) )
end if
end sub
'':::::
function resolveHost _
( _
byref hostname as string _
) as integer
dim ia as in_addr
dim hostentry as hostent ptr
'' check if it's an ip address
ia.S_addr = inet_addr( hostname )
if ( ia.S_addr = INADDR_NONE ) then
'' if not, assume it's a name, resolve it
hostentry = gethostbyname( hostname )
if ( hostentry = 0 ) then
exit function
end if
function = *cast( integer ptr, *hostentry->h_addr_list )
else
'' just return the address
function = ia.S_addr
end if
end function
'':::::
sub reportError _
( _
byref msg as string _
)
#ifdef __FB_WIN32__
print msg; ": error #" & WSAGetLastError( )
#else
perror( msg )
#endif
end sub
'':::::
sub doInit
#ifdef __FB_WIN32__
'' init winsock
dim wsaData as WSAData
if( WSAStartup( MAKEWORD( 1, 1 ), @wsaData ) <> 0 ) then
print "Error: WSAStartup failed"
end 1
end if
#endif
end sub
'':::::
sub doShutdown
#ifdef __FB_WIN32__
'' quit winsock
WSACleanup
#endif
end sub
'::::
Function HTTPGet(hostname as string,path as string,port As Integer,HTTP_UA As String,referer as string) As String
'' globals
doInit( )
'' check command-line
'getHostAndPath( command, hostname, path )
if( len( hostname ) = 0 ) then
HTTPGet=""
'print "A1"
Exit Function
end if
'' resolve name
dim ip as integer
dim s as SOCKET
ip = resolveHost( hostname )
if( ip = 0 ) then
HTTPGet=""
Exit Function
end if
'' open socket
s = opensocket( AF_INET, SOCK_STREAM, IPPROTO_TCP )
if( s = 0 ) then
HTTPGet=""
Exit Function
end if
'' connect to host
dim sa as sockaddr_in
sa.sin_port = htons( port )
sa.sin_family = AF_INET
sa.sin_addr.S_addr = ip
if ( connect( s, cast( PSOCKADDR, @sa ), len( sa )) = SOCKET_ERROR ) then
HTTPGet=""
Exit Function
end 1
end if
'' send HTTP request
dim sendbuffer as string
If HTTP_UA="" Then
sendBuffer = "GET /" + path + " HTTP/1.0" + NEWLINE + _
"Host: " + hostname + NEWLINE + _
"Connection: close" + NEWLINE + _
"Referer: " + referer + NEWLINE + _
"User-Agent: Mozilla/5.0 (X11; Linux i686; rv:6.0) Gecko/20100101 Firefox/6.0 " + NEWLINE + _
NEWLINE
else
sendBuffer = "GET /" + path + " HTTP/1.0" + NEWLINE + _
"Host: " + hostname + NEWLINE + _
"Connection: close" + NEWLINE + _
"User-Agent: " + HTTP_UA + NEWLINE + _
NEWLINE
End If
if( send( s, sendBuffer, len( sendBuffer ), 0 ) = SOCKET_ERROR ) then
HTTPGet=""
closesocket( s )
Exit Function
end if
'' receive until connection is closed
dim recvbuffer as zstring * RECVBUFFLEN+1
dim bytes as integer
Dim recvStr As String
Dim split_http As Long
do
bytes = recv( s, recvBuffer, RECVBUFFLEN, 0 )
if( bytes <= 0 ) then
exit do
end if
'' add the null-terminator
recvbuffer[bytes] = 0
'' print buffer as a string
recvStr=recvStr+recvbuffer
loop
split_http=InStr(recvStr,CONTENTSTART)
HTTPGet=mid(recvStr,split_http+4,Len(recvStr)-split_http-3)
'' close socket
shutdown( s, 2 )
closesocket( s )
''
doShutdown( )
'':::::
End Function
''不要用相同字符替换相同字符，死机了不管我P事，等下再改进！
Function Replace(SearchLine As String, SearchFor As String, ReplaceWith As String) As String
Dim vSearchLine As String, found As Integer
vSearchLine=SearchLine
Do
found = InStr(vSearchLine,SearchFor)
If found=0 Then
Replace = vSearchLine
Exit Do
Else
'Len(SearchFor)=1,found=1 =2
vSearchLine=Mid(vSearchLine,1,found-1)+ReplaceWith+Mid(vSearchLine,Len(SearchFor)+found,Len(vSearchLine)-found)
End If
Loop
End Function
Function StartTranslate(english As String) As String
Dim result As String
Dim rc As Integer,rb As Integer
Dim resout As String
Dim surl As String
if english="" then
StartTranslate=""
exit function
end if
surl=Replace(english,Chr(32),"+")
surl=Replace(surl,Chr(0),"+")
surl=Replace(surl,Chr(0),"+")
surl=Replace(surl,Chr(10),"+")
surl=Replace(surl,Chr(13),"+")
'print "/?js=n&prev=_t&hl=en&ie=UTF-8&layout=2&eotf=1&sl=en&tl=zh-CN&text="+surl+"&file="
'print
result = HTTPGet("translate.google.com","/?js=n&prev=_t&hl=en&ie=UTF-8&layout=2&eotf=1&sl=en&tl=zh-CN&text="+surl+"&file=",80,"","http://translate.google.com")
rc=InStr(result,"onmouseover=""this.style.backgroundColor='#ebeff9'"" onmouseout=""this.style.backgroundColor='#fff'"">")
rb=InStr(result,"</span></span></div></div><div")
resout=Mid(result,rc+98,rb-rc-98)
result=""
resout=Replace(resout,"'","'")
rc=InStr(resout,"</span><span title=""")
rb=InStr(resout,""" onmouseover=""this.style.backgroundColor='#ebeff9'"" onmouseout=""this.style.backgroundColor='#fff'"">")
resout = Mid(resout,1,rc-1)+Mid(resout,rb+rc+80,Len(resout)-rb-rc-78)
StartTranslate=resout
End Function
Sub Main()
dim sb as string
dim inttemp as integer
dim sechtemp as string
dim latetemp as string
dim trstring as string
Open "template.po" For Input As #1
Open "out.po" For Output As #2
Do While Not EOF(1)
Input #1,sb
if instr(sb,"#") and ((instr(sb,"msgid")=0) Or instr(sb,"msgid")>instr(sb,"#")) Then
print #2,sb
elseif instr(sb,"msgid") then
inttemp = InStr(sb,"""")
sechtemp = Mid(sb,inttemp+1,Len(sb)-inttemp)
inttemp = InStrRev(sechtemp,"""")
sechtemp=Mid(sechtemp,1,inttemp-1)
elseif instr(sb,"msgstr") then
inttemp = InStr(sb,"""")
latetemp = Mid(sb,inttemp+1,Len(sb)-inttemp)
inttemp = InStrRev(latetemp,"""")
latetemp=Mid(latetemp,1,inttemp-1)
if latetemp="" Or latetemp=sechtemp then '没翻译的
'print "Orig Text:"+sechtemp
trstring=StartTranslate(sechtemp)
print "Translate:"""+sechtemp + """ To :""" + trstring + """"
print #2,"#,fuzzy"
print #2,"msgid """+sechtemp+""""
print #2,"msgstr """+trstring+""""
print #2,""
else
print "Nothing to translate!"
'print #2,"#,fuzzy"
print #2,"msgid """+sechtemp+""""
print #2,"msgstr """+latetemp+""""
print #2,""
end if
end if
Loop
Close #2
Close #1
End Sub
Main()
