求：pb 程序自动更新的源代码

[dongfang_beback]

那位仁兄有 pb 程序自动更新的源代码，包括上传、下载功能，给小弟发一份，救小弟于水深火热之中，先谢谢了！

[dongfang_beback]

我的邮箱:[e-mail]

[hlp912]

我没有源码，只有可执行程序

[dlook]

通过ftp来做，很简单的呀

[dlook]

1、系统进入的时候，检测版本，若版本不符合，则运行更新程序，并退出。
2、更新程序做友好提示，版本升级信息。
//升级按钮的脚本
integer li_bat,li_bat2,i //文件名指针
boolean b_ok
string ls_ftp
this.enabled = false
Select C_FtpServer into :ls_ftp from B_SystemParm ;//获取FTP服务器IP
if fileexists('D:\operation\operation.exe') then//因为我的程序是固定一个地方，所以这
//样，你们可以采用读注册表的方法来获取安装路径
//动态生成bat文件，采用cmd方式执行
li_bat = FileOpen('get_file.bat',lineMode!, Write!, LockWrite!, Replace!)
FileWrite(li_bat, 'cd D:\operation\')
FileWrite(li_bat, 'ftp -s:a.bat -A '+ ls_ftp) //匿名登陆，可以在这里配置你的密码等信息
FileWrite(li_bat, 'exit')
li_bat2 = FileOpen('a.bat',lineMode!, Write!, LockWrite!, Replace!)
FileWrite(li_bat2, 'cd wfgl')
FileWrite(li_bat2, 'mget *.*') //获取所有文件
FileWrite(li_bat2, '') //测试时发现要加空回车，因为会询问是否覆盖啊什么的，所以加了很多这种东西
FileWrite(li_bat2, '')
FileWrite(li_bat2, '')
FileWrite(li_bat2, '')
FileWrite(li_bat2, '')
FileWrite(li_bat2, '')
FileWrite(li_bat2, '')
FileWrite(li_bat2, '')
FileWrite(li_bat2, '')
FileWrite(li_bat2, '')
FileWrite(li_bat2, '')
FileWrite(li_bat2, '')
FileWrite(li_bat2, '')
FileWrite(li_bat2, '')
FileWrite(li_bat2, '')
FileWrite(li_bat2, '')
FileWrite(li_bat2, '')
FileWrite(li_bat2, '')
FileWrite(li_bat2, '')
FileWrite(li_bat2, '')
FileWrite(li_bat2, 'bye') //退出
FileClose(li_bat)
FileClose(li_bat2)
Run('get_file.BAT',Minimized!)
st_1.visible = true

sleep(50000)//调用了API，因为下载文件需要一定时间，在这段时间内，要保证单线
//程，所以学习微软的良好做法，睡！
loop1:

b_ok = filedelete('get_file.BAT')
if not b_ok then
goto loop1
end if
loop2:
b_ok = filedelete('a.BAT')
if not b_ok then
goto loop2
end if//删除零时文件，如果删除不成功，说明还在下载，循环一下。
st_1.visible = false//这个文本主要是显示斗大的字，提醒他们正在升级，当然
//如果你们加动态条就更友好些。
messagebox('','升级成功')
end if

//接下来就看你们要干什么了！

[dlook]

哦，上传，嗯，为什么要上传？
不过道理相同，查下ftp的命令好了。

[rightyeah]

一个类，楼主看着玩吧
$PBExportHeader$u_app_update.sru
forward
global type u_app_update from nonvisualobject
end type
end forward

type FILETIME from structure
ulong low
ulong high
end type

type systemtime from structure
integer wyear
integer wmonth
integer wdayofweek
integer wday
integer whour
integer wminute
integer wsecond
integer wmilliseconds
end type

type win32_find_data from structure
long dwfileattributes
filetime ftcreationtime
filetime ftlastaccesstime
filetime ftlastwritetime
long nfilesizehigh
long nfilesizelow
long dwreserved0
long dwreserved1
character cfilename[260]
character calternate[14]
end type

type OFSTRUCT from structure
character cBytes
character fFixedDisk
integer nErrCode
integer Reserved1
integer Reserved2
character szPathName[128]
end type

global type u_app_update from nonvisualobject autoinstantiate
event type integer error ( integer code, string errtext )
end type

type prototypes
Function long FindFirstFileA ( string lpFileName , ref win32_find_data lpFindFileData ) Library "kernel32"
Function long FindClose (long hFindFile ) Library "kernel32"
Function long FindNextFileA (long hFindFile, ref win32_find_data lpFindFileData) Library "kernel32"
Function long FileTimeToSystemTime (ref filetime lpFileTime ,ref systemtime lpSystemTime ) Library "kernel32"
FUNCTION ulong GetModuleFileNameA(ulong hModule,ref string lpFileName,ulong nSize) LIBRARY "kernel32.dll"
Function long OpenFile (string lpFileName,ref OFSTRUCT lpReOpenBuff, long wStyle ) LIBRARY "kernel32.dll"
Function long SetFileTime(long hFile ,ref filetime lpCreationTime,ref filetime lpLastAccessTime ,ref filetime lpLastWriteTime ) LIBRARY "kernel32.dll"
Function long CloseHandle (long hObject ) LIBRARY "kernel32.dll"

end prototypes

type variables
transaction io_sqlca
powerobject io_attach
string is_event
constant string CFG='_CFG_'
end variables

forward prototypes
public function integer upload (string filelist, string path)
public function string array2string (character aa[])
public subroutine settransobject (ref transaction ao)
public function string getapplicationpath ()
public function integer upload (string filelist)
public function integer download (string filelist, string path)
public function integer download (string filelist)
public function integer test (string filelist, string path)
public function integer test (string filelist)
public subroutine attachobject (readonly powerobject ao, string as_event)
public function integer setconfigstring (string as_name, string as_string)
public function string getconfigstring (string as_name)
end prototypes

event error;//if code<>0 then
// messagebox(string(code),errtext)
//end if
if isvalid(io_attach) then
error.Number=code
error.text=errtext
error.object=classname()
io_attach.postevent(is_event)
end if
return 0

end event

public function integer upload (string filelist, string path);win32_find_data lstr
systemtime lstr_tm
string ls_filename,ls_allfile,ls_files[],ls_time
long ll_handle,ll_ret,i,ll,ll_fh
boolean lb
blob lbb,lbb2
if not isvalid(io_sqlca) then
this.event error(-1,'there r no transaction object')
return -1
end if
lb=io_sqlca.autocommit
io_sqlca.autocommit=false
ls_allfile=filelist
split(ls_allfile,';',ls_files)
ll=upperbound(ls_files)
for i=1 to ll
ll_handle=findfirstfilea(path+ls_files[i],lstr)
if ll_handle=-1 then
this.event error(-2,'file not found : ' +ls_files[i])
continue
end if
ls_filename=array2string(lstr.cfilename)
ls_time=string(lstr.ftLastWriteTime.high,'0000000000')+'-'+string(lstr.ftLastWriteTime.low,'0000000000')
findclose(ll_handle)
select count(*) into :ll_ret from appupdate where app_name =:ls_files[i] using io_sqlca;
if ll_ret=0 then
insert into appupdate(app_name,app_date,app_type) values(:ls_files[i],getdate(),'0') using io_sqlca;
if io_sqlca.sqlcode<>0 then
rollback using io_sqlca;
this.event error(-3,'insert data failure : ' +ls_files[i])
continue
end if
end if
//read from file to lbb
ll_fh=fileopen(path+ls_files[i],StreamMode!,Read!,shared! )
lbb=blob('')
do while fileread(ll_fh,lbb2)>0
lbb=lbb+ lbb2
loop
fileclose(ll_fh)
//write to database
updateblob appupdate set data=:lbb where app_name=:ls_files[i] using io_sqlca;
if io_sqlca.sqlcode<0 then
rollback using io_sqlca;
this.event error(-4,'save data failure : ' +ls_files[i])
continue
end if
update appupdate set timestamp=:ls_time where app_name=:ls_files[i] using io_sqlca;
if io_sqlca.sqlcode<0 then
rollback using io_sqlca;
this.event error(-4,'save data failure : ' +ls_files[i])
continue
end if
commit using io_sqlca;
this.event error(0,'success to update file : '+ls_files[i] )
//messagebox('','success to update file : '+ls_files[i] )
next
//end_line:
io_sqlca.autocommit=lb
return 0 //success

end function

public function string array2string (character aa[]);string ls
long i,ll
ll=upperbound(aa)
for i=1 to ll
ls+=string(aa[i])
next
return ls
end function

public subroutine settransobject (ref transaction ao);io_sqlca=ao

end subroutine

[rightyeah]

public function string getapplicationpath ();string str_AppPath,str_ch,str_appdir
long int_ret
integer l_str,i
//以下是获取应用程序所在的目录
str_AppPath = Space (128)
int_ret = GetModuleFileNameA (Handle (GetApplication ()), str_Apppath, 128)
l_str=len(str_apppath)
i=l_str
str_ch=''
do while str_ch<>'\'
str_ch=mid(str_apppath,i,1)
i --
loop
str_appdir=mid(str_apppath,1,i + 1)
return str_appdir
end function

public function integer upload (string filelist);return upload(filelist,getapplicationpath())
end function

public function integer download (string filelist, string path);win32_find_data lstr
filetime lstr_tm
ofstruct lstr_ofs
string ls_filename,ls_allfile,ls_files[],ls_time,ls_time2
long ll_handle,ll_ret,i,ll,ll_fh,ll_pos,ll_len
boolean lb
blob lbb,lbb2
if not isvalid(io_sqlca) then
this.event error(-1,'there r no transaction object')
return -1
end if
lb=io_sqlca.autocommit
io_sqlca.autocommit=false
ls_allfile=filelist
split(ls_allfile,';',ls_files)
ll=upperbound(ls_files)
for i=1 to ll
ll_handle=findfirstfilea(path+ls_files[i],lstr)
select timestamp into :ls_time2 from appupdate where app_name =:ls_files[i] using io_sqlca;
if io_sqlca.sqlcode<0 then
rollback using io_sqlca;
this.event error(-5,'fail to load data : ' +ls_files[i])
continue
elseif io_sqlca.sqlcode=100 then
rollback using io_sqlca;
this.event error(-6,'there r no this file : ' +ls_files[i])
continue
end if
if ll_handle>=0 then //有文件，则比较修改时间
ls_filename=array2string(lstr.cfilename)
ls_time=string(lstr.ftLastWriteTime.high,'0000000000')+'-'+string(lstr.ftLastWriteTime.low,'0000000000')
findclose(ll_handle)
if ls_time2<=ls_time then continue
end if
selectblob data into :lbb from appupdate where app_name =:ls_files[i] using io_sqlca;
if io_sqlca.sqlcode<0 then
rollback using io_sqlca;
this.event error(-5,'fail to load data : ' +ls_files[i])
continue
elseif io_sqlca.sqlcode=100 then
rollback using io_sqlca;
this.event error(-6,'there r no this file : ' +ls_files[i])
continue
end if
//write to file
ll_fh=fileopen(path+ls_files[i],StreamMode!,Write!,LockWrite! ,Replace! )
if ll_fh=-1 then
this.event error(-7,'fail to open file : '+ls_files[i])
continue
end if
ll_len=len(lbb)
ll_pos=1
do while ll_pos<=ll_len
lbb2=blobmid(lbb,ll_pos,32765)
ll_pos+=len(lbb2)
filewrite(ll_fh,lbb2)
loop
fileclose(ll_fh)
//set file time
lstr_tm.low=long(right(ls_time2,10))
lstr_tm.high=long(left(ls_time2,10))
ll_fh=openfile(path+ls_files[i],lstr_ofs,2)//OF_READWRITE = &H2
if ll_fh<1 then
this.event error(-7,'fail to open file : '+ls_files[i])
continue
end if
if setfiletime(ll_fh,lstr_tm,lstr_tm,lstr_tm)=0 then
this.event error(-8,'fail to set file time : '+ls_files[i])
continue
end if
closehandle(ll_fh)

this.event error(0,'success to update file : '+ls_files[i] )
//messagebox('','success to update file : '+ls_files[i] )
next
//end_line:
io_sqlca.autocommit=lb
return 0 //success

end function

public function integer download (string filelist);return download(filelist,getapplicationpath())
end function

public function integer test (string filelist, string path);win32_find_data lstr
systemtime lstr_tm
string ls_filename,ls_allfile,ls_files[],ls_time,ls_time2
long ll_handle,ll_ret,i,ll,ll_fh,ll_pos,ll_len
boolean lb
blob lbb,lbb2
if not isvalid(io_sqlca) then
this.event error(-1,'there r no transaction object')
return -1
end if
lb=io_sqlca.autocommit
io_sqlca.autocommit=false
ls_allfile=filelist
split(ls_allfile,';',ls_files)
ll=upperbound(ls_files)
for i=1 to ll
ll_handle=findfirstfilea(path+ls_files[i],lstr)
if ll_handle>=0 then //有文件，则比较修改时间
ls_filename=array2string(lstr.cfilename)
ls_time=string(lstr.ftLastWriteTime.high,'0000000000')+'-'+string(lstr.ftLastWriteTime.low,'0000000000')
findclose(ll_handle)
select timestamp into :ls_time2 from appupdate where app_name =:ls_files[i] using io_sqlca;
if io_sqlca.sqlcode<0 then
rollback using io_sqlca;
this.event error(-5,'fail to load data : ' +ls_files[i])
continue
elseif io_sqlca.sqlcode=100 then
rollback using io_sqlca;
this.event error(-6,'there r no this file : ' +ls_files[i])
continue
end if
if ls_time2>ls_time then return 1 else continue
end if
io_sqlca.autocommit=lb
return 1 //需要更新
next
//end_line:
io_sqlca.autocommit=lb
return 0 //success

end function

public function integer test (string filelist);return test(filelist,getapplicationpath())
end function

public subroutine attachobject (readonly powerobject ao, string as_event);io_attach=ao
is_event=as_event
end subroutine

public function integer setconfigstring (string as_name, string as_string);long ll_cnt,ll_ret
blob lbb
boolean lb
as_name=CFG+as_name
lb=io_sqlca.autocommit
io_sqlca.autocommit=false
select count(*) into :ll_cnt from appupdate where app_name=:as_name using io_sqlca;
if ll_cnt =0 then
insert into appupdate(app_name,app_date,app_type) values(:as_name,getdate(),'0') using io_sqlca;
if io_sqlca.sqlcode<> 0 then
ll_ret =io_sqlca.sqlcode
//messagebox(string(io_sqlca.sqlcode),io_sqlca.sqlerrtext)
rollback using io_sqlca;
goto end_line
end if
end if
lbb=blob(as_string)
updateblob appupdate set data=:lbb where app_name=:as_name using io_sqlca;
if io_sqlca.sqlcode<> 0 then
ll_ret =io_sqlca.sqlcode
//messagebox(string(io_sqlca.sqlcode),io_sqlca.sqlerrtext)
rollback using io_sqlca;
goto end_line
end if

end_line:
io_sqlca.autocommit=lb
return ll_ret

end function
public function string getconfigstring (string as_name);blob lbb
as_name=CFG+as_name
setnull(lbb)
selectblob data into :lbb from appupdate where app_name =:as_name using io_sqlca;
if isnull(lbb) then return '' else return string(lbb)

end function

on u_app_update.create
TriggerEvent( this, "constructor" )
end on

on u_app_update.destroy
TriggerEvent( this, "destructor" )
end on