Ubuntu中文论坛

代码： 全选

''
'' 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()