forum.clarionlife.net

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

  PROGRAM

  MAP
    MyProcReturningString(), *STRING
    MyTest()
  END

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

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

  PROGRAM

  MAP
    MyProcReturningString(), *STRING
    MyTest()
  END

  CODE
  MyTest()
  
MyTest                        PROCEDURE()
sRef                            &STRING
  CODE
  sRef &= MyProcReturningString()
  MESSAGE(sRef)
  DISPOSE(sRef)

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

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

  MAP
    MODULE('TEST01.CLW')  
      MyProcReturningString(), *STRING
      MyTest()
    END  
  END
  
   CODE
   MyTest()

   ! И переносим процедуры в файл TEST01.CLW

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

  MEMBER

  MAP
    MyProcReturningString(), *STRING
    MyTest()
  END

MyTest                        PROCEDURE()
sRef                            &STRING
  CODE
  sRef &= MyProcReturningString()
  MESSAGE(sRef)
  DISPOSE(sRef)

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

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

  PROGRAM

  MAP
    MODULE('Test1.clw')
      MyProcReturningString(), *STRING
      MyTest()
    END
  END

  CODE
  MyTest()
  

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

 Map
   GetStrHTTP(string,*ulong,byte),*string   ! Получить результат запроса по HTTP в строку
   
    Module('Windows API Functions')
        InternetOpen(*CString lpszAgent, Ulong dwAccessType, <*Cstring lpszProxy>,<*Cstring lpszProxyBypass>,Ulong wFlags),UnSigned,Raw,Pascal,Name('InternetOpenA')
        InternetCloseHandle(UnSigned),Bool,Raw,Pascal,Name('InternetCloseHandle')
        InternetOpenURL(UnSigned,*CSTRING Url,<*CSTRING Headers>,Ulong,Ulong,Ulong),UnSigned,RAW,PASCAL,PROC,NAME('InternetOpenUrlA')
        InternetReadFile(UnSigned,*?,Ulong,*Ulong),BOOL,RAW,PASCAL,PROC
        CloseHandle(UnSigned),BOOL,PASCAL,RAW,PROC
    end
 end
 
 ! Вызов
 Str   &String 
 Loc:Size Ulong
  Code 

  Str &= GetStrHTTP('http://clarionlife.net',Loc:Size,True)
  If (Loc:Size > 0) and ~(Str &= NULL) then Message(Str).
  Dispose(Str)
  
  ! ------------

GetStrHTTP          PROCEDURE  (xURL_,xSize_,xMessage_)   ! Получить строку по HTTP запросу
Loc:Info1            &STRING                               !
Loc:Info2            &STRING                               !
NTERNET_OPEN_TYPE_DIRECT       EQUATE(1)
INTERNET_OPEN_TYPE_PRECONFIG    EQUATE(0)
INTERNET_OPEN_TYPE_PROXY        EQUATE(3)

Loc:hSession      UnSigned
Loc:hUrl          UnSigned
Loc:MyUrl         CSTRING(255)
Agent             CSTRING('MySoft')
Loc:BufferLength  ULong
Loc:Total         ULONG(0)

Loc:BufferSize    EQUATE(1024)
Loc:Buffer        Group
                    BYTE,DIM(Loc:BufferSize)
                  end
                  
  CODE
  xSize_     = 0
  Loc:MyUrl  = Clip(Left(xURL_))
  Loc:Info1 &= NULL

  Loc:hSession = InternetOpen(Agent,INTERNET_OPEN_TYPE_PRECONFIG,,,0);

  If Loc:hSession
     Loc:hUrl = InternetOpenUrl(Loc:hSession,Loc:myUrl,,0,0,0)
     If Loc:hUrl     
        Loc:Total  = 0                            ! Счетчик в буфер загруженных байт
        Loc:Info1 &= New(String(Loc:BufferSize))  ! Создать начальный буфер
        
        Loop
          Loc:Buffer = All('<0>')
          InternetReadFile(Loc:hUrl,Loc:Buffer,Loc:Buffersize,Loc:BufferLength)
          If Loc:BufferLength > 0

             If (Loc:Total + Loc:BufferLength) > Size(Loc:Info1)         ! Если буфер мал
                Loc:Info2 &= New(String(Loc:Total + Loc:BufferLength))   ! Увеличить его размер
                Loc:Info2  = Loc:Info1                                   
                Dispose(Loc:Info1)                                       
                Loc:Info1 &= Loc:Info2                                 
             end
                                                                         ! Запись загруженного блока в буфер
             Loc:Info1[(Loc:Total + 1):(Loc:Total + Loc:BufferLength)] = Loc:Buffer
             Loc:Total += Loc:BufferLength              ! Увеличить счетчик загрузки
          end

        Until Loc:BufferLength = 0    

        xSize_ = Loc:Total     ! Всего загружено байт

        If InternetCloseHandle(Loc:hUrl).

     elsIf xMessage_ = True
        Message(' Нет доступа к запросу по HTTP: ' & Clip(Loc:MyUrl),'У нас проблема !',Icon:Exclamation,'&1. Закрыть')
        Display
     end

     If InternetCloseHandle(Loc:hSession).

  elsIf xMessage_ = True
     Message(' Нет доступа по протоколу HTTP !','У нас проблема !',Icon:Exclamation,'&1. Закрыть')
     Display
  end

  Return Loc:Info1