Set Escape Off
Set Deleted On
Set Safety Off
Set Date To Dmy
Set Century On
If Empty(Thisform.txtfrom.Value) Or Empty(Thisform.txtto.Value)
Messagebox('Kaynak ve Hedef Dizinler Seçilmedi..',16,'Opppps')
Return
Endif
If ! File(Addbs(Thisform.txtfrom.Value)+'data1.dbc')
Messagebox('Kaynak Dizin Geçerli Database İçermiyor (data1.dbc)',16,'Hata...')
Return
Endif
If ! File(Addbs(Thisform.txtto.Value)+'data1.dbc')
Messagebox('Hedef Dizin Geçerli Database İçermiyor (data1.dbc)',16,'Hata...')
Return
Endif
Local LcFrom,Lcto,OldPath,FirstLcFrom1,FirstLcFrom,FirstLcTo
OldPath = Sys(5)+Curdir()
FirstLcFrom = Alltrim(Thisform.txtfrom.Value)
FirstLcFrom1 = Justfname(Alltrim(Thisform.txtfrom.Value))
FirstLcTo = Alltrim(Thisform.txtto.Value)
LcFrom = Addbs(Thisform.txtfrom.Value)
Lcto = Addbs(Thisform.txtto.Value)
Close Databases All
&&--- first backup current database -----------------------------------------------------
Local LcSourcePath,LcTargetPath
LcSourcePath =Alltrim(Thisform.txtfrom.Value) &&Sys(5)+Curdir()+'data03'
LcTargetPath = LcSourcePath + '_BACKUP_' + Substr(Dtoc(Date()),1,2) + Substr(Dtoc(Date()),4,2) + Substr(Dtoc(Date()),7,4)+"_" + ;
SUBSTR(Tran(Time()),1,2)+Substr(Tran(Time()),4,2)+Substr(Tran(Time()),7,2)
Wait Window "Update Öncesi Yedek Alınıyor...." Nowait
oFSO=Createobject("Scripting.FileSystemObject")
oFSO.CopyFolder("&LcSourcePath","&LcTargetPath",.T.) && data olmazsa kendi yaratır
Messagebox("Yedekleme Başarılı....Yedeklenen Klasör Adı: "+ m.LcTargetPath,64,_Screen.Caption)
&&----- renaming current data dir -------------------------------------------------------
Local LcRenameTo
LcRenameTo = 'RENAMED_' + Substr(Dtoc(Date()),1,2) + Substr(Dtoc(Date()),4,2) + Substr(Dtoc(Date()),7,4)+"_" + ;
SUBSTR(Tran(Time()),1,2)+Substr(Tran(Time()),4,2)+Substr(Tran(Time()),7,2)
fso = Createobject("Scripting.FileSystemObject")
oFolder = fso.GetFolder(m.LcFrom) &&rename folder
oFolder.Name = m.LcRenameTo
Messagebox("Mevcut Data Dizini "+ m.LcRenameTo + " Olarak Değiştirildi...",64,_Screen.Caption)
&&----- renaming new data structure data dir to current dir name ------------------------
fso1 = Createobject("Scripting.FileSystemObject")
oFolder1 = fso1.GetFolder(m.Lcto) &&rename folder
oFolder1.Name = m.FirstLcFrom1 &&"data03" &&m.FirstLcFrom muste be give only folder name
Messagebox("Yeni Yapılandırılmış " + m.FirstLcTo + " Dizini " + m.FirstLcFrom + " Olarak Değiştirildi...",64,_Screen.Caption)
*---------------------------------------------------------------------------------------
Set Path To Data &&update for myaudit
Local LcOldDir,LcNewDir,LcTable
LcOldDir = m.OldPath + m.LcRenameTo + "\" &&ADDBS("...")
LcNewDir = m.OldPath + m.FirstLcFrom1 + "\" &&ADDBS("...")
Local lcUpdatelog
lcupdatelog = Sys(5)+Curdir()+"updatelog.txt"
Set Textmerge To (m.lcupdatelog) Noshow
Set Textmerge On
\UPDATED TABLE LIST
LOCAL lnFileNums
m.lnFileNums = Adir(laTableList, m.LcNewDir + "*.dbf")
For i=1 To lnFileNums
LcTable = laTableList[i,1]
\<<m.lctable>>
Wait Window " Eski " + m.LcTable +" Kayıtları..Yeni Tabloya Kopyalanıyor... " + m.LcTable Nowait
IF NOT EMPTY(SYS(2000,m.LcOldDir + m.LcTable))
Use (m.LcNewDir + m.LcTable) Exclusive
Append From (m.LcOldDir + m.LcTable)
Use
ENDIF
Endfor
&&---------------
Set Textmerge Off
Set Textmerge To
Messagebox("Eski Kayıtlar Yeni Dataset e kopyalandı...tablo listesini log dan inceleyebilirsiniz..." + ;
m.lcupdatelog,64,'Data Updater Result')
Close All