forum.clarionlife.net

Код: Выделить всё

WebLoadFile          FUNCTION (lop:rFileName,lop:lFileName,lop:progr,lop:break) ! Объявление процедуры
FilesOpened          LONG
Loc:Ok               BYTE
Loc:Bytes            LONG
Loc:Status           LONG
hSession    HINTERNET      !ссылка на сессию
hUrl        HINTERNET      !ссылка на remote-файл
MyUrl       CSTRING(255)   !имя remote-файла
LocalFile   CSTRING(255)   !имя локального файла
hLocal      HANDLE         !ссылка на локальный файл

Agent       CSTRING('WebCopy 0.000001b')  !агент

BufferSize      EQUATE(1024)   !значение размера буфера для загрузки файла
Buffer          Group          !буфер для загрузки файла
                  BYTE,DIM(BufferSize)
                End

BufferLength    DWORD    !размер буфера для загрузки файла (как переменная для передачи адреса в функциях api)
IndexNum        DWORD    !номер индекса для функции HttpQueryInfo
FileSize        DWORD    !размер загружаемого файла

Total           LONG   !счетчик загруженных байт
  CODE                                           ! Начало исполняемого кода
      MyUrl = clip(lop:rFileName)      !имя remote-файла
      LocalFile = Clip(lop:lFileName)  !имя локального файла
      loc:ok=0   !установить признак, что файл не загружен
      hSession = InternetOpen(Agent,INTERNET_OPEN_TYPE_PRECONFIG,,,0)  !открыть сессию
      if hSession   !если сессия открыта успешно
        !hUrl = InternetOpenUrl(hSession, myUrl,,0,0,0)   !открыть ссылку на remote-файл
        hUrl = InternetOpenUrl(hSession, myUrl,,0,INTERNET_FLAG_RELOAD,0)   !открыть ссылку на remote-файл
        BufferLength=BufferSize   !установить размер буфера для передачи данных
        HttpQueryInfo(hUrl,HTTP_QUERY_STATUS_CODE,Buffer,BufferLength,IndexNum)  !запросить наличие remote-файла
        Loc:Status=Buffer         !сохранить признак наличия remote-файла
        if lop:progr<>0 and Loc:Status=HTTP_STATUS_OK   !если передана ссылка на прогрессор и remote-файл есть
           BufferLength=BufferSize   !установить размер буфера для передачи данных
           HttpQueryInfo(hUrl,HTTP_QUERY_CONTENT_LENGTH,Buffer,BufferLength,IndexNum)  !запросить размер remote-файла в байтах
           FileSize=Buffer                       !сохранить размер remote-файла
           lop:progr{PROP:RangeLow}=0            !установить диапазон для прогрессора
           lop:progr{PROP:RangeHigh}=FileSize
        .
        BufferLength=0   !обнулить размер буфера для загрузки файла
        if hUrl          !если есть ссылка на remote-файл
          if Loc:Status=HTTP_STATUS_OK    !если remote-файл существует
             hLocal = CreateFile(LocalFile, GENERIC_READ+GENERIC_WRITE, |   !создать ссылку на локальный файл
                              FILE_SHARE_READ + FILE_SHARE_WRITE, ,|
                              CREATE_ALWAYS, FILE_ATTRIBUTE_NORMAL,0)
             loc:ok = 1    !установить признак успешной загрузки
             loop          !загрука remote-файла порциями
                Buffer = All('<0>')     !инициализация буфера
                InternetReadFile(hUrl, Buffer, Buffersize, BufferLength)  !чтение порции
                if BufferLength <> 0       !если что-то прочитано
                   Total += BufferLength   !увеличиваем счетчик загруженных байт
                   if lop:progr<>0         !обновляем прогрессор
                      lop:progr{PROP:Progress}=Total
                   .
                   if ~WriteFile(hLocal, Buffer, BufferLength, BufferLength)  !записываем в локальный файл
                      loc:ok = 0  !при ошибке сбрасываем признак успешной загрузки
                      break
                   .
                   if lop:break<>0  !обработка кнопки прерывания процесса
                      do break_r
                      if loc:ok=0
                         break
                      .
                   .
                .
             until BufferLength = 0
             CloseHandle(hLocal)  !закрываем локальный файл
          .
          InternetCloseHandle(hUrl)  !закрываем remote-файл
        .
        InternetCloseHandle(hSession)  !закрываем сессию
      .
  
  RETURN(Loc:Ok)

break_r routine
  0{PROP:TIMER}=1
  Cycles#=0
  accept
     case field()
        of lop:break
          case event()
             of event:accepted
                loc:ok=0
                break
          .
     .
     if event()=event:timer
        Cycles#+=1
        if Cycles#>1
           break
        .
     .
  .
  0{PROP:TIMER}=0

Код: Выделить всё

sRef  &STRING
  CODE
  sRef = MyProcReturningString()

Код: Выделить всё

MyProcReturningString Procedure(),*string
  
Loc:Str &String
  
   Code
   
   Loc:Str &= New(String(30))   
   Loc:Str = 'Привет !'
   Return(Loc:Str)
   
   ! --------------------
   
   Code

sRef  &STRING
  CODE
  sRef = MyProcReturningString()
  Message(sRef) ! - Здесь ничего нет

Код: Выделить всё

MyProcReturningString Procedure(),string

Код: Выделить всё

  PROGRAM

  MAP
    MyProcReturningString(), *STRING
  END

sRef                          &STRING

  CODE
  sRef &= MyProcReturningString()
  MESSAGE(sRef)
  
MyProcReturningString         PROCEDURE()
str                             &STRING
  CODE
  str &= NEW STRING(100)
  str = 'MyProcReturningString'
  RETURN str