как работать с Firebird
Модератор: Дед Пахом
Правила форума
При написании вопроса или обсуждении проблемы, не забывайте указывать версию Clarion который Вы используете.
А так же пользуйтесь спец. тегами при вставке исходников!!!
При написании вопроса или обсуждении проблемы, не забывайте указывать версию Clarion который Вы используете.
А так же пользуйтесь спец. тегами при вставке исходников!!!
-
StillZero
- Ветеран
- Сообщения: 458
- Зарегистрирован: 06 Июль 2005, 2:17
- Откуда: Хабаровск
- Поблагодарили: 1 раз
- Контактная информация:
Re: как работать с Firebird
не, намного лучше, я то парился за отступы, отступы есть
по аэродрому...
Re: как работать с Firebird
Ребята я закипел, что за буфер GP вы чистите?
И паралельно вопрос: можно ли создать DNS соединение из CLARION и можно ли убить его.
И паралельно вопрос: можно ли создать DNS соединение из CLARION и можно ли убить его.
...
Re: как работать с Firebird
Насчет Firebird - не скажу, не знаю, а насчет DNS... Может просто использовать строку соединения для работы, без создания DNS. Для DB2 это выглядит так:BBR писал(а):Ребята я закипел, что за буфер GP вы чистите?
И паралельно вопрос: можно ли создать DNS соединение из CLARION и можно ли убить его.
Driver={IBM DB2 ODBC DRIVER};Database=myDataBase;Hostname=myServerAddress;Port=1234;Protocol=TCPIP;Uid=myUsername;Pwd=myPassword;
Может народ подскажет как для Firebird? Или поискать в I-Net-е
как работать с Firebird
Пришлось немного повозится с FTP, по лени, в той же манере:
Проект - EXE. Для создания DLL - используйте класс.
С приветом из 2008, Andrew Art
Код: Выделить всё
program
DWORD EQUATE(ULONG)
HANDLE EQUATE(UNSIGNED)
WORD EQUATE(SIGNED)
LPCSTR EQUATE(CSTRING)
WIN32_FIND_DATA_Def Group,type
dwFileAttributes Long
ftCreationTime:dwLowDateTime Long
ftCreationTime:dwHighDateTime Long
ftLastAccessTime:dwLowDateTime Long
ftLastAccessTime:dwHighDateTime Long
ftLastWriteTime:dwLowDateTime Long
ftLastWriteTime:dwHighDateTime Long
nFileSizeHigh Long
nFileSizeLow Long
dwReserved0 Long
dwReserved1 Long
cFileName CString(261)
cAlternate CString(15)
End
MAP
module('wininet.lib')
InternetOpen(*lpcstr,dword,*lpcstr,dword,dword),handle,pascal,raw,NAME('InternetOpenA'),dll(1)
InternetOpenURL(handle,*lpcstr,dword,dword,dword,dword),handle,pascal,raw,name('InternetOpenURLA'),dll(1)
InternetReadFile(handle,*lpcstr,dword,*dword),handle,pascal,raw,name('InternetReadFile'),dll(1)
InternetCloseHandle(handle),pascal,raw,name('InternetCloseHandle'),dll(1)
! Далее мое творчество
InternetConnect(handle,*lpcstr,dword,*lpcstr,*lpcstr,dword,dword,dword),handle,pascal,raw,NAME('InternetConnectA'),dll(1)
HttpOpenRequest(handle,*lpcstr,*lpcstr,*lpcstr,*lpcstr,dword,dword,dword),handle,pascal,raw,name('HttpOpenRequestA'),dll(1)
HttpSendRequest(handle,*lpcstr,dword,*lpcstr,dword),handle,pascal,raw,name('HttpSendRequestA'),dll(1)
! и еще
! HttpSendRequestEx(handle,*lpcstr,*lpcstr,dword,dword ),pascal,raw,NAME('HttpSendRequestExA'),dll(1)
! HttpEndRequest(handle,*lpcstr,dword,dword),pascal,raw,name('HttpEndRequest'),dll(1)
! и еще FTP
FtpGetCurrentDirectory(long,*cstring,*long),long,raw,pascal,name('FtpGetCurrentDirectoryA'),dll(1)
FtpSetCurrentDirectory(long,*cstring),long,raw,pascal,name('FtpSetCurrentDirectoryA'),dll(1)
FtpCreateDirectory(long,*cstring),long,raw,pascal,name('FtpCreateDirectoryA'),dll(1)
FtpRemoveDirectory(long,*cstring),long,raw,pascal,name('FtpRemoveDirectoryA'),dll(1)
FtpDeleteFile(long,*cstring),long,raw,pascal,name('FtpDeleteFileA'),dll(1)
FtpRenameFile(long,*cstring,*cstring),long,raw,pascal,name('FtpRenameFileA'),dll(1)
FtpGetFile(long,*cstring,*cstring,long,long,long,long),long,raw,pascal,name('FtpGetFileA'),dll(1)
FtpPutFile(long,*cstring,*cstring,long,long),long,raw,pascal,name('FtpPutFileA'),dll(1)
FtpFindFirstFile(long,*cstring,win32_find_data_def,long,long),long,raw,pascal,name('FtpFindFirstFileA'),dll(1)
FtpOpenFile(long,*cstring,long,long,long),long,raw,pascal,name('FtpOpenFileA'),dll(1)
FtpGetFileSize(long,long),long,raw,pascal,dll(1)
! FtpFindFirstFile(long,*cstring,win32_find_data_def,long,long),long,raw,pascal,name('FtpFindFirstFileA')
end
! и еще
CreateDirFTP(string srvdir, string srvlogin, string srvpsw, string srvurl), long ! Ftp Create Directory
Postadata(string pstserv, string pstexe, *string pstarea, *string pTextBuf), long !URL POST Data Server Data
GetAFileFTP(string srvfile,string locfile,string srvlogin, string srvpsw, string srvurl), long ! Ftp Get File
PutAFileFTP(string locfile,string srvfile,string srvlogin, string srvpsw, string srvurl), long ! Ftp Put File
DeleteDirFTP(string srvdir, string srvlogin, string srvpsw, string srvurl), long ! Ftp Remove Directory
DeleteFileFTP(string srvfile, string srvlogin, string srvpsw, string srvurl), long ! Ftp Remove File
RenameFileFTP(string srvfile, string srvnewfile, string srvlogin, string srvpsw, string srvurl), long ! Ftp Remove File
end
serv string(250) ! Сервер http://www.nechto.com
pexe string(250) ! CGI or PHP nechto.exe
bff string(64000) ! Post data in structure &p1=123&p2=rtr...&pn=4
text1 string(528000) ! In data - maybe %20 and so on
FTP string(250) ! Сервер http://www.nechto.com
FL string(60) ! Сервер http://www.nechto.com
FS string(60) ! Сервер http://www.nechto.com
file_up string(60)
usr0 string(32) ! Сервер http://www.nechto.com
psw0 string(32)
newdir string(250)
Window WINDOW('WinInet samples'),AT(,,395,355),FONT('MS Sans Serif',8,,FONT:regular),CENTER,GRAY
TEXT,AT(12,7,373,187),USE(Text1),BOXED,HVSCROLL
BUTTON('Lookup'),AT(269,214,33,14),USE(?lookup)
BUTTON('Exit'),AT(311,214,33,14),USE(?OkButton),LEFT,DEFAULT
ENTRY(@s100),AT(11,215,191,10),USE(pexe)
ENTRY(@s100),AT(11,228,191,10),USE(bff)
ENTRY(@s60),AT(11,242,191,10),USE(File_up)
BUTTON('Toweb'),AT(275,276,49,14),USE(?Toftp)
ENTRY(@s60),AT(13,276,191,10),USE(FTP)
PROMPT('FTP server'),AT(215,278),USE(?Prompt1)
ENTRY(@s60),AT(13,290,191,10),USE(FS)
BUTTON('Fromweb'),AT(275,298,49,14),USE(?Fromftp)
PROMPT('On Server '),AT(215,292),USE(?Prompt2)
ENTRY(@s60),AT(13,305,191,10),USE(FL)
PROMPT('On local'),AT(215,306),USE(?Prompt3)
PROMPT('New directory'),AT(215,320),USE(?Prompt4)
ENTRY(@s80),AT(13,322,191,10),USE(Newdir)
BUTTON('CreateDir'),AT(275,318,49,14),USE(?Button5)
ENTRY(@s100),AT(11,202,191,10),USE(serv)
END
code
! this code is only executed if linked as an .exe
serv = 'localhost/mt'
pexe = 'pswgen.exe'
bff = '&a=2222&b=1111'
ftp = '192.168.1.22'
usr0 = 'Prototype'
psw0 = '827963114'
open (window)
accept
if accepted() = ?okbutton then break.
if accepted() = ?lookup then
clear(text1)
rtn# = postadata(serv,pexe,bff,text1)
if rtn# <> 0 then
message('http didnt work - ' & rtn#,'Error',icon:exclamation)
else
message('Ok http - ' & rtn#,'Error',icon:exclamation)
end
display()
end
if accepted() = ?Toftp then
clear(text1)
rtn# = PutAFileFTP(FL,FS,USR0,PSW0,FTP)
if rtn# <> 0 then
message('FTP Put didnt work - ' & rtn#,'Error',icon:exclamation)
else
message('Ok FTP PUT - ' & rtn#,'Error',icon:exclamation)
end
display()
end
if accepted() = ?Fromftp then
clear(text1)
rtn# = GetAFileFTP(FS,FL,USR0,PSW0,FTP)
if rtn# <> 0 then
message('FTP Get didnt work - ' & rtn#,'Error',icon:exclamation)
else
message('Ok Get FTP - ' & rtn#,'Error',icon:exclamation)
end
display()
end
if accepted() = ?Button5 then
clear(text1)
rtn# = CreateDirFTP(NewDir,USR0,PSW0,FTP)
if rtn# <> 0 then
message('Create Dir didnt work - ' & rtn#,'Error',icon:exclamation)
else
message('Ok Create Dir - ' & rtn#,'Error',icon:exclamation)
end
display()
end
end ! accept loop
!----------------------------------------------------------------------------------------
PostaData Procedure(string pstserv, string pstexe, *string pstarea, *string pTextBuf)
!----------------------------------------------------------------------------------------
! InternetOpen Сессия
! InternetConnect Коннект
! HttpOpenRequest Запрос
! HttpSendRequest Послать
! InternetReadFile Получить
! InternetCloseHandle Закрыть запрос
! InternetCloseHandle Закрыть коннект
! InternetCloseHandle Закрыть сессию
!----------------------------------------------------------------------------------------
UserAgent cstring('Mozilla/4.0 (compatible; MSIE 6.0b; Windows NT 5.0; .NET CLR 1.0.2914)')
ProxyName CSTRING(1000)
OpenType dword
bufferlen equate(528001)
HTTPbuffer cstring(bufferlen)
Headerlen Dword
Headerbuf cstring(250),AUTO ! Content-Type: application/x-www-form-urlencoded
Postlen Dword
postbuf cstring(64000),AUTO ! name=John+Doe&userid=hithere&other=P%26Q
bytesread dword
! Open Flags
INTERNET_OPEN_TYPE_PRECONFIG EQUATE(0) !- use registry configuration
INTERNET_OPEN_TYPE_DIRECT EQUATE(1) !- direct to net
INTERNET_OPEN_TYPE_PROXY EQUATE(3) !- via named proxy
!OpenURL dwFlags
INTERNET_FLAG_NO_CACHE_WRITE EQUATE(04000000H) ! Does not add the returned entity to the cache.
INTERNET_FLAG_RELOAD equate(80000000H) ! Forces a download of the requested file, object,
! or directory listing from the origin server, not from the cache.
INTERNET_FLAG_PRAGMA_NOCACHE equate(00000100H) ! Forces the request to be resolved by the origin server,
! even if a cached copy exists on the proxy.
NoCaching equate(84000100H) ! all of the above
INTERNET_DEFAULT_HTTP_PORT equate(00000050H) ! Номер TCP/IP порта к которому мы собираемся подсоединиться
INTERNET_SERVICE_HTTP equate(00000003H) ! Тип сервиса - FTP, HTTP или Gopher
ZERO DWORD
hsession handle
hconnect handle
hrequest Handle
hReadFile handle
hsend handle
dwFlags dword
dwContext dword
postserv cstring(250),AUTO
postexe cstring(250),AUTO
pTextBufLen long
Pageptr long
ReturnCode long
usid cstring(20)
psw cstring(20)
postv cstring(20)
acc dword
version cstring(20)
reff cstring(20)
s0 long
code
postv = 'POST'
Headerbuf = 'Content-Type: application/x-www-form-urlencoded' & '<0>'
headerlen = len(Headerbuf)
postserv = clip(pstserv) & '<0>'
postexe = clip(pstexe) & '<0>'
! loop s0 = 1 to 8000
! if pstarea[s0] = ' ' then break .
! postbuf[s0] = pstarea[s0]
! end
! postbuf[s0] = '<0>'
postbuf = CLIP(PSTAREA) & '<0>'
postlen = len(postbuf)
pTextBufLen = len(pTextBuf)
OpenType = INTERNET_OPEN_TYPE_PRECONFIG
ReturnCode = 0
version = 'HTTP/1.1<0>'
reff = 'http://s775/rocom.exe<0>'
usid = 'anonymous<0>'
psw = '<0>'
hsession = InternetOpen(UserAgent,OpenType,ProxyName,zero,zero)
if hsession = 0 then
ReturnCode = 1 !* Error * Internet Open error
else
dwFlags = NoCaching
hconnect = InternetConnect(hsession,postserv,INTERNET_DEFAULT_HTTP_PORT, usid, psw, INTERNET_SERVICE_HTTP, dwFlags, dwContext)
if hconnect = 0 then
ReturnCode = 2 !* Error * Internet Connect error
else
hrequest = HttpOpenRequest(hConnect, postv, postexe, version, reff, 0, dwFlags, dwContext);
if hrequest = 0 then
ReturnCode = 3 !* Error * Internet Request error
else
hsend = HttpSendRequest(hRequest, headerbuf, headerlen, postbuf, postlen)
if hsend = false then
ReturnCode = 4 !* Error * Internet send error
else
Pageptr = 1
loop
hReadFile = InternetReadFile(hRequest,HTTPbuffer,bufferlen-1,bytesread)
if hReadFile = true and bytesread = 0 then break.
if bytesread > 0 then
if Pageptr + bytesread > pTextBuflen then
Returncode = 5 ! * Error * Buffer size exceeded
break
end
pTextBuf = pTextBuf[1:Pageptr] & HTTPbuffer[1:bytesread] ! + first byte always _
Pageptr += bytesread
end
end
end
end
end
end
internetclosehandle(hrequest)
internetclosehandle(hconnect)
internetclosehandle(hsession)
return(ReturnCode)
!----------------------------------------------------------------------------------------
GetAFileFTP Procedure(string srvfile, string locfile, string srvlogin, string srvpsw, string srvurl) ! Ftp Get File
!----------------------------------------------------------------------------------------
! InternetOpen Сессия
! InternetConnect Коннект
! FTPGetFile Получить файл
! InternetCloseHandle Закрыть коннект
! InternetCloseHandle Закрыть сессию
!----------------------------------------------------------------------------------------
UserAgent cstring('Windiws 7 FTP agent')
ProxyName CSTRING(1000)
OpenType dword
! Open Flags
INTERNET_OPEN_TYPE_PRECONFIG EQUATE(0) !- use registry configuration
INTERNET_OPEN_TYPE_DIRECT EQUATE(1) !- direct to net
INTERNET_OPEN_TYPE_PROXY EQUATE(3) !- via named proxy
!OpenURL dwFlags
INTERNET_FLAG_NO_CACHE_WRITE EQUATE(04000000H) ! Does not add the returned entity to the cache.
INTERNET_FLAG_RELOAD equate(80000000H) ! Forces a download of the requested file, object,
! or directory listing from the origin server, not from the cache.
INTERNET_FLAG_PRAGMA_NOCACHE equate(00000100H) ! Forces the request to be resolved by the origin server,
! even if a cached copy exists on the proxy.
NoCaching equate(84000100H) ! all of the above
INTERNET_DEFAULT_FTP_PORT equate(00000015H) ! Номер TCP/IP порта к которому мы собираемся подсоединиться
INTERNET_SERVICE_FTP equate(00000001H) ! Тип сервиса - FTP, HTTP или Gopher
INTERNET_FLAG_PASSIVE EQUATE(08000000h) ! Тип соединения - пассивный 0 - активный
ZERO DWORD
hsession handle
hconnect handle
hrequest Handle
dwFlags dword
dwContext dword
ftp_serv cstring(250),AUTO
file_srv cstring(250),AUTO
file_loc cstring(250),AUTO
pTextBufLen long
Pageptr long
ReturnCode long
usid cstring(32)
psw cstring(32)
postv cstring(32)
acc dword
version cstring(32)
reff cstring(32)
code
ftp_serv = clip(srvurl) & '<0>'
file_srv = clip(srvfile) & '<0>'
file_loc = clip(locfile) & '<0>'
OpenType = INTERNET_OPEN_TYPE_PRECONFIG
ReturnCode = 0
version = 'HTTP/1.1<0>'
reff = 'http://s775/rocom.exe<0>'
usid = clip(srvlogin) & '<0>'
psw = clip(srvpsw) & '<0>'
hsession = InternetOpen(UserAgent,OpenType,ProxyName,zero,zero)
if hsession = 0 then
ReturnCode = 1 !* Error * Internet Open error
else
dwFlags = INTERNET_FLAG_PASSIVE
hconnect = InternetConnect(hsession,ftp_serv,INTERNET_DEFAULT_FTP_PORT, usid, psw, INTERNET_SERVICE_FTP, dwFlags, dwContext)
if hconnect = 0 then
ReturnCode = 2 !* Error * Internet Connect error
else
hrequest = FtpGetFile( hconnect, file_srv, file_loc, False, 0, 2, 0)
if hrequest = false then
ReturnCode = 3 !* Error * Internet Request error
end
end
end
internetclosehandle(hconnect)
internetclosehandle(hsession)
return(ReturnCode)
!----------------------------------------------------------------------------------------
PutAFileFTP Procedure(string locfile, string srvfile, string srvlogin, string srvpsw, string srvurl) ! Ftp Put File
!----------------------------------------------------------------------------------------
! InternetOpen Сессия
! InternetConnect Коннект
! FTPGetFile Получить файл
! InternetCloseHandle Закрыть коннект
! InternetCloseHandle Закрыть сессию
!----------------------------------------------------------------------------------------
UserAgent cstring('Expi FTP agent')
ProxyName CSTRING(1000)
OpenType dword
! Open Flags
INTERNET_OPEN_TYPE_PRECONFIG EQUATE(0) !- use registry configuration
INTERNET_OPEN_TYPE_DIRECT EQUATE(1) !- direct to net
INTERNET_OPEN_TYPE_PROXY EQUATE(3) !- via named proxy
!OpenURL dwFlags
INTERNET_FLAG_NO_CACHE_WRITE EQUATE(04000000H) ! Does not add the returned entity to the cache.
INTERNET_FLAG_RELOAD equate(80000000H) ! Forces a download of the requested file, object,
! or directory listing from the origin server, not from the cache.
INTERNET_FLAG_PRAGMA_NOCACHE equate(00000100H) ! Forces the request to be resolved by the origin server,
! even if a cached copy exists on the proxy.
NoCaching equate(84000100H) ! all of the above
INTERNET_DEFAULT_FTP_PORT equate(00000015H) ! Номер TCP/IP порта к которому мы собираемся подсоединиться
INTERNET_SERVICE_FTP equate(00000001H) ! Тип сервиса - FTP, HTTP или Gopher
INTERNET_FLAG_PASSIVE EQUATE(08000000h) ! Тип соединения - пассивный 0 - активный
ZERO DWORD
hsession handle
hconnect handle
hrequest Handle
dwFlags dword
dwContext dword
ftp_serv cstring(250),AUTO
file_srv cstring(250),AUTO
file_loc cstring(250),AUTO
pTextBufLen long
Pageptr long
ReturnCode long
usid cstring(32)
psw cstring(32)
postv cstring(32)
acc dword
version cstring(32)
reff cstring(32)
code
ftp_serv = clip(srvurl) & '<0>'
file_srv = clip(srvfile) & '<0>'
file_loc = clip(locfile) & '<0>'
OpenType = INTERNET_OPEN_TYPE_PRECONFIG
ReturnCode = 0
version = 'HTTP/1.1<0>'
usid = clip(srvlogin) & '<0>'
psw = clip(srvpsw) & '<0>'
hsession = InternetOpen(UserAgent,OpenType,ProxyName,zero,zero)
if hsession = 0 then
ReturnCode = 1 !* Error * Internet Open error
else
dwFlags = INTERNET_FLAG_PASSIVE
hconnect = InternetConnect(hsession,ftp_serv,INTERNET_DEFAULT_FTP_PORT, usid, psw, INTERNET_SERVICE_FTP, dwFlags, dwContext)
if hconnect = 0 then
ReturnCode = 2 !* Error * Internet Connect error
else
hrequest = FtpPutFile( hconnect, file_loc, file_srv, 2, 0)
if hrequest = false then
ReturnCode = 3 !* Error * Internet Request error
end
end
end
internetclosehandle(hconnect)
internetclosehandle(hsession)
return(ReturnCode)
!----------------------------------------------------------------------------------------
CreateDirFTP Procedure(string srvdir, string srvlogin, string srvpsw, string srvurl) ! Create FTP derectory
!----------------------------------------------------------------------------------------
! InternetOpen Сессия
! InternetConnect Коннект
! FTPGetFile Получить файл
! InternetCloseHandle Закрыть коннект
! InternetCloseHandle Закрыть сессию
!----------------------------------------------------------------------------------------
UserAgent cstring('Windiws 7 FTP agent')
ProxyName CSTRING(1000)
OpenType dword
! Open Flags
INTERNET_OPEN_TYPE_PRECONFIG EQUATE(0) !- use registry configuration
INTERNET_OPEN_TYPE_DIRECT EQUATE(1) !- direct to net
INTERNET_OPEN_TYPE_PROXY EQUATE(3) !- via named proxy
!OpenURL dwFlags
INTERNET_FLAG_NO_CACHE_WRITE EQUATE(04000000H) ! Does not add the returned entity to the cache.
INTERNET_FLAG_RELOAD equate(80000000H) ! Forces a download of the requested file, object,
! or directory listing from the origin server, not from the cache.
INTERNET_FLAG_PRAGMA_NOCACHE equate(00000100H) ! Forces the request to be resolved by the origin server,
! even if a cached copy exists on the proxy.
NoCaching equate(84000100H) ! all of the above
INTERNET_DEFAULT_FTP_PORT equate(00000015H) ! Номер TCP/IP порта к которому мы собираемся подсоединиться
INTERNET_SERVICE_FTP equate(00000001H) ! Тип сервиса - FTP, HTTP или Gopher
INTERNET_FLAG_PASSIVE EQUATE(08000000H) ! Тип соединения - пассивный 0 - активный
ZERO DWORD
hsession handle
hconnect handle
hrequest Handle
dwFlags dword
dwContext dword
ftp_serv cstring(250),AUTO
Ftp_dir cstring(250),AUTO
pTextBufLen long
Pageptr long
ReturnCode long
usid cstring(32)
psw cstring(32)
postv cstring(32)
acc dword
version cstring(32)
reff cstring(32)
code
ftp_serv = clip(srvurl) & '<0>'
FTP_dir = clip(srvdir) & '<0>'
OpenType = INTERNET_OPEN_TYPE_PRECONFIG
ReturnCode = 0
version = 'HTTP/1.1<0>'
usid = clip(srvlogin) & '<0>'
psw = clip(srvpsw) & '<0>'
hsession = InternetOpen(UserAgent,OpenType,ProxyName,zero,zero)
if hsession = 0 then
ReturnCode = 1 !* Error * Internet Open error
else
dwFlags = 0
hconnect = InternetConnect(hsession,ftp_serv,INTERNET_DEFAULT_FTP_PORT, usid, psw, INTERNET_SERVICE_FTP, dwFlags, dwContext)
if hconnect = 0 then
ReturnCode = 2 !* Error * Internet Connect error
else
hrequest = FtpCreateDirectory(hconnect,FTP_dir)
if hrequest = false then
ReturnCode = 3 !* Error * Internet Request error
end
end
end
internetclosehandle(hconnect)
internetclosehandle(hsession)
return(ReturnCode)
!----------------------------------------------------------------------------------------
DeleteDirFTP Procedure(string srvdir, string srvlogin, string srvpsw, string srvurl) ! Delete FTP derectory
!----------------------------------------------------------------------------------------
! InternetOpen Сессия
! InternetConnect Коннект
! FTPGetFile Получить файл
! InternetCloseHandle Закрыть коннект
! InternetCloseHandle Закрыть сессию
!----------------------------------------------------------------------------------------
UserAgent cstring('Windiws 7 FTP agent')
ProxyName CSTRING(1000)
OpenType dword
! Open Flags
INTERNET_OPEN_TYPE_PRECONFIG EQUATE(0) !- use registry configuration
INTERNET_OPEN_TYPE_DIRECT EQUATE(1) !- direct to net
INTERNET_OPEN_TYPE_PROXY EQUATE(3) !- via named proxy
!OpenURL dwFlags
INTERNET_FLAG_NO_CACHE_WRITE EQUATE(04000000H) ! Does not add the returned entity to the cache.
INTERNET_FLAG_RELOAD equate(80000000H) ! Forces a download of the requested file, object,
! or directory listing from the origin server, not from the cache.
INTERNET_FLAG_PRAGMA_NOCACHE equate(00000100H) ! Forces the request to be resolved by the origin server,
! even if a cached copy exists on the proxy.
NoCaching equate(84000100H) ! all of the above
INTERNET_DEFAULT_FTP_PORT equate(00000015H) ! Номер TCP/IP порта к которому мы собираемся подсоединиться
INTERNET_SERVICE_FTP equate(00000001H) ! Тип сервиса - FTP, HTTP или Gopher
INTERNET_FLAG_PASSIVE EQUATE(08000000H) ! Тип соединения - пассивный 0 - активный
ZERO DWORD
hsession handle
hconnect handle
hrequest Handle
dwFlags dword
dwContext dword
ftp_serv cstring(250),AUTO
Ftp_dir cstring(250),AUTO
pTextBufLen long
Pageptr long
ReturnCode long
usid cstring(32)
psw cstring(32)
postv cstring(32)
acc dword
version cstring(32)
reff cstring(32)
code
ftp_serv = clip(srvurl) & '<0>'
FTP_dir = clip(srvdir) & '<0>'
OpenType = INTERNET_OPEN_TYPE_PRECONFIG
ReturnCode = 0
version = 'HTTP/1.1<0>'
usid = clip(srvlogin) & '<0>'
psw = clip(srvpsw) & '<0>'
hsession = InternetOpen(UserAgent,OpenType,ProxyName,zero,zero)
if hsession = 0 then
ReturnCode = 1 !* Error * Internet Open error
else
dwFlags = 0
hconnect = InternetConnect(hsession,ftp_serv,INTERNET_DEFAULT_FTP_PORT, usid, psw, INTERNET_SERVICE_FTP, dwFlags, dwContext)
if hconnect = 0 then
ReturnCode = 2 !* Error * Internet Connect error
else
hrequest = FtpRemoveDirectory(hconnect,FTP_dir)
if hrequest = false then
ReturnCode = 3 !* Error * Internet Request error
end
end
end
internetclosehandle(hconnect)
internetclosehandle(hsession)
return(ReturnCode)
!----------------------------------------------------------------------------------------
DeleteFileFTP Procedure(string srvfile, string srvlogin, string srvpsw, string srvurl) ! Delete Srv file
!----------------------------------------------------------------------------------------
! InternetOpen Сессия
! InternetConnect Коннект
! FTPGetFile Получить файл
! InternetCloseHandle Закрыть коннект
! InternetCloseHandle Закрыть сессию
!----------------------------------------------------------------------------------------
UserAgent cstring('Windiws 7 FTP agent')
ProxyName CSTRING(1000)
OpenType dword
! Open Flags
INTERNET_OPEN_TYPE_PRECONFIG EQUATE(0) !- use registry configuration
INTERNET_OPEN_TYPE_DIRECT EQUATE(1) !- direct to net
INTERNET_OPEN_TYPE_PROXY EQUATE(3) !- via named proxy
!OpenURL dwFlags
INTERNET_FLAG_NO_CACHE_WRITE EQUATE(04000000H) ! Does not add the returned entity to the cache.
INTERNET_FLAG_RELOAD equate(80000000H) ! Forces a download of the requested file, object,
! or directory listing from the origin server, not from the cache.
INTERNET_FLAG_PRAGMA_NOCACHE equate(00000100H) ! Forces the request to be resolved by the origin server,
! even if a cached copy exists on the proxy.
NoCaching equate(84000100H) ! all of the above
INTERNET_DEFAULT_FTP_PORT equate(00000015H) ! Номер TCP/IP порта к которому мы собираемся подсоединиться
INTERNET_SERVICE_FTP equate(00000001H) ! Тип сервиса - FTP, HTTP или Gopher
INTERNET_FLAG_PASSIVE EQUATE(08000000H) ! Тип соединения - пассивный 0 - активный
ZERO DWORD
hsession handle
hconnect handle
hrequest Handle
dwFlags dword
dwContext dword
ftp_serv cstring(250),AUTO
Ftp_file cstring(250),AUTO
pTextBufLen long
Pageptr long
ReturnCode long
usid cstring(32)
psw cstring(32)
postv cstring(32)
acc dword
version cstring(32)
reff cstring(32)
code
ftp_serv = clip(srvurl) & '<0>'
FTP_file = clip(srvfile) & '<0>'
OpenType = INTERNET_OPEN_TYPE_PRECONFIG
ReturnCode = 0
version = 'HTTP/1.1<0>'
usid = clip(srvlogin) & '<0>'
psw = clip(srvpsw) & '<0>'
hsession = InternetOpen(UserAgent,OpenType,ProxyName,zero,zero)
if hsession = 0 then
ReturnCode = 1 !* Error * Internet Open error
else
dwFlags = 0
hconnect = InternetConnect(hsession,ftp_serv,INTERNET_DEFAULT_FTP_PORT, usid, psw, INTERNET_SERVICE_FTP, dwFlags, dwContext)
if hconnect = 0 then
ReturnCode = 2 !* Error * Internet Connect error
else
hrequest = FtpDeleteFile(hconnect,FTP_file)
if hrequest = false then
ReturnCode = 3 !* Error * Internet Request error
end
end
end
internetclosehandle(hconnect)
internetclosehandle(hsession)
return(ReturnCode)
!----------------------------------------------------------------------------------------
RenameFileFTP Procedure(string srvfile, string srvnewfile, string srvlogin, string srvpsw, string srvurl) ! Rename Srv file
!----------------------------------------------------------------------------------------
! InternetOpen Сессия
! InternetConnect Коннект
! FTPGetFile Получить файл
! InternetCloseHandle Закрыть коннект
! InternetCloseHandle Закрыть сессию
!----------------------------------------------------------------------------------------
UserAgent cstring('Windiws 7 FTP agent')
ProxyName CSTRING(1000)
OpenType dword
! Open Flags
INTERNET_OPEN_TYPE_PRECONFIG EQUATE(0) !- use registry configuration
INTERNET_OPEN_TYPE_DIRECT EQUATE(1) !- direct to net
INTERNET_OPEN_TYPE_PROXY EQUATE(3) !- via named proxy
!OpenURL dwFlags
INTERNET_FLAG_NO_CACHE_WRITE EQUATE(04000000H) ! Does not add the returned entity to the cache.
INTERNET_FLAG_RELOAD equate(80000000H) ! Forces a download of the requested file, object,
! or directory listing from the origin server, not from the cache.
INTERNET_FLAG_PRAGMA_NOCACHE equate(00000100H) ! Forces the request to be resolved by the origin server,
! even if a cached copy exists on the proxy.
NoCaching equate(84000100H) ! all of the above
INTERNET_DEFAULT_FTP_PORT equate(00000015H) ! Номер TCP/IP порта к которому мы собираемся подсоединиться
INTERNET_SERVICE_FTP equate(00000001H) ! Тип сервиса - FTP, HTTP или Gopher
INTERNET_FLAG_PASSIVE EQUATE(08000000H) ! Тип соединения - пассивный 0 - активный
ZERO DWORD
hsession handle
hconnect handle
hrequest Handle
dwFlags dword
dwContext dword
ftp_serv cstring(250),AUTO
Ftp_file cstring(250),AUTO
Ftp_newfile cstring(250),AUTO
pTextBufLen long
Pageptr long
ReturnCode long
usid cstring(32)
psw cstring(32)
postv cstring(32)
acc dword
version cstring(32)
reff cstring(32)
code
ftp_serv = clip(srvurl) & '<0>'
FTP_file = clip(srvfile) & '<0>'
FTP_newfile = clip(srvnewfile) & '<0>'
OpenType = INTERNET_OPEN_TYPE_PRECONFIG
ReturnCode = 0
version = 'HTTP/1.1<0>'
usid = clip(srvlogin) & '<0>'
psw = clip(srvpsw) & '<0>'
hsession = InternetOpen(UserAgent,OpenType,ProxyName,zero,zero)
if hsession = 0 then
ReturnCode = 1 !* Error * Internet Open error
else
dwFlags = 0
hconnect = InternetConnect(hsession,ftp_serv,INTERNET_DEFAULT_FTP_PORT, usid, psw, INTERNET_SERVICE_FTP, dwFlags, dwContext)
if hconnect = 0 then
ReturnCode = 2 !* Error * Internet Connect error
else
hrequest = FtpRenameFile(hconnect,FTP_file,Ftp_newfile)
if hrequest = false then
ReturnCode = 3 !* Error * Internet Request error
end
end
end
internetclosehandle(hconnect)
internetclosehandle(hsession)
return(ReturnCode)С приветом из 2008, Andrew Art
