Получить из Procedure() то, сам не знаю что ....

Clarion, Clarion 7

Модератор: Дед Пахом

Правила форума
При написании вопроса или обсуждении проблемы, не забывайте указывать версию Clarion который Вы используете.
А так же пользуйтесь спец. тегами при вставке исходников!!!
Аватара пользователя
Игорь Столяров
Ветеран движения
Сообщения: 8031
Зарегистрирован: 07 Июль 2005, 10:19
Откуда: г. Ростов-на-ДоМу
Благодарил (а): 28 раз
Поблагодарили: 96 раз

Получить из Procedure() то, сам не знаю что ....

Сообщение Игорь Столяров »

Дед Пахом писал(а): хотя вот так работает:
Нет. В этом примере завуалированная работа с указателем в глобальной памяти.
Можно вообще не заморачиваться с возвращением указателя - он и так везде доступен.
Вот так не работает:

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

  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 
Make Clarion Great Again ! 😎
Аватара пользователя
Дед Пахом
Старичок
Сообщения: 3289
Зарегистрирован: 07 Июль 2005, 16:51
Откуда: Москва, Россия
Благодарил (а): 15 раз
Поблагодарили: 49 раз
Контактная информация:

Получить из Procedure() то, сам не знаю что ....

Сообщение Дед Пахом »

Почему у меня работает? Постю свой код, найдите 10 отличий:

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

  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 
  
С уважением, ДП
Аватара пользователя
Игорь Столяров
Ветеран движения
Сообщения: 8031
Зарегистрирован: 07 Июль 2005, 10:19
Откуда: г. Ростов-на-ДоМу
Благодарил (а): 28 раз
Поблагодарили: 96 раз

Получить из Procedure() то, сам не знаю что ....

Сообщение Игорь Столяров »

Дед Пахом писал(а): Постю свой код, найдите 10 отличий:
И у меня работает ... Секунду - я должен все проверить ...
Make Clarion Great Again ! 😎
Аватара пользователя
Игорь Столяров
Ветеран движения
Сообщения: 8031
Зарегистрирован: 07 Июль 2005, 10:19
Откуда: г. Ростов-на-ДоМу
Благодарил (а): 28 раз
Поблагодарили: 96 раз

Получить из Procedure() то, сам не знаю что ....

Сообщение Игорь Столяров »

Нашел. Вот так не работает. При сборке в APP.
Пипец вообще ... :(
Пойду узнаю, может быть где-то требуются водители на маршрутку.
Не хочу быть больше программистом.

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


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

   ! И переносим процедуры в файл TEST01.CLW
Make Clarion Great Again ! 😎
Аватара пользователя
Дед Пахом
Старичок
Сообщения: 3289
Зарегистрирован: 07 Июль 2005, 16:51
Откуда: Москва, Россия
Благодарил (а): 15 раз
Поблагодарили: 49 раз
Контактная информация:

Получить из Procedure() то, сам не знаю что ....

Сообщение Дед Пахом »

Работает :D Код Test1.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()
  
С уважением, ДП
Аватара пользователя
Игорь Столяров
Ветеран движения
Сообщения: 8031
Зарегистрирован: 07 Июль 2005, 10:19
Откуда: г. Ростов-на-ДоМу
Благодарил (а): 28 раз
Поблагодарили: 96 раз

Получить из Procedure() то, сам не знаю что ....

Сообщение Игорь Столяров »

Все работает. Я баран.
Если процедура возвращает адрес - то присваивать ее результат надо как адрес: sRef &= MyProcReturningString()
А я делал как значение: sRef = MyProcReturningString()

Огромное спасибо !
Это действительно простое и элегантное решение моего вопроса. :)
Еще есть чему учится и это хорошо. ;)
О какие просторы теперь открываются для Web запросов ! :cat:
Make Clarion Great Again ! 😎
Аватара пользователя
Admin
Администратор
Сообщения: 4010
Зарегистрирован: 05 Июль 2005, 15:59
Откуда: Хабаровск
Благодарил (а): 53 раза
Поблагодарили: 33 раза
Контактная информация:

Получить из Procedure() то, сам не знаю что ....

Сообщение Admin »

Игорь Столяров писал(а): А я делал как значение: sRef = MyProcReturningString()
Просто ты устал! :idied:
Рай совершает ошибки ничуть не реже чем ад. Просто у него хорошая пресса
Аватара пользователя
Игорь Столяров
Ветеран движения
Сообщения: 8031
Зарегистрирован: 07 Июль 2005, 10:19
Откуда: г. Ростов-на-ДоМу
Благодарил (а): 28 раз
Поблагодарили: 96 раз

Получить из Procedure() то, сам не знаю что ....

Сообщение Игорь Столяров »

Вот что получилось в результате. Красота ! :)

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

 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
  
Make Clarion Great Again ! 😎
Ответить