На главную Наши проекты:
Журнал   ·   Discuz!ML   ·   Wiki   ·   DRKB   ·   Помощь проекту
ПРАВИЛА FAQ Помощь Поиск Участники Календарь Избранное RSS
msm.ru
! Соблюдайте общие правила форума
Пожалуйста, выделяйте текст программы тегом [сode=pas] ... [/сode]. Для этого используйте кнопку [code=pas] в форме ответа или комбобокс, если нужно вставить код на языке, отличном от Дельфи/Паскаля.
Указывайте точные версии Delphi и используемых сетевых библиотек.

Не приветствуется поднятие старых тем. Если ваш вопрос перекликается со старой темой, то для вопроса лучше создать новую тему, а старую указать в первом сообщении с описанием взаимосвязи.
Внимание:
попытки открытия обсуждений реализации вредоносного ПО, включая различные интерпретации спам-ботов, наказывается предупреждением на 30 дней.
Повторная попытка - 60 дней. Последующие попытки бан.
Мат в разделе - бан на три месяца...
Полезные ссылки:
user posted image MSDN Library user posted image FAQ раздела user posted image Поиск по разделу user posted image Как правильно задавать вопросы

Выразить свое отношение к модераторам раздела можно здесь: user posted image Krid, user posted image Rouse_

Модераторы: Krid, Rouse_
  
> Добавить функцию в рабочий модуль для отображения кирилицы в СМС. Как? , Нужно прикрутить функцию в рабочий модуль компонента для корректного отображения кирилицы
Massaget
Сообщ. #1 ,
    Newbie
    Профиль · PM
    Рейтинг (т): нет
    Есть рабочий модуль стороннего компонента. Компонент успешно отправляет СМС на латинице.
    Кирилицу отправляет, но некорректно отображает текст. Т.е. вместо кирилицы отображаются символы собачки "@", греческие символы,
    некоторые Unicode символы и цифры.
    Пытался переделать модуль путём добавления функций Encode7bit и ucs2 в переменную текста сообщения. Но вместо желаемого русского всякий раз читал кашу из нечитаемых символов.

    Дело очень срочное! Поэтому прошу всех кто имеет возможность прикрутить поддержку кирилицы.
    А было бы идельно если сможете добавить и мультипарт.
    Ребята, выручайте!

    Скрытый текст

    ExpandedWrap disabled
      Unit SMSkin;
       
      interface
       
      uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs;
       
      type
          TNewMessageEvent            = procedure(Sender: TObject; const AFrom, AMessage: String; var ADelete: Boolean) of Object;
       
          function                      MessageEncode(ACenter, AAddress, AMessage: AnsiString): AnsiString;
          procedure                    MessageDecode(AValue: AnsiString; var ACenter, AAddress, AMessage: AnsiString);
      ...
        Protected
      ...
        Public
      ...
        Published
      ...
        End;
       
      implementation
       
      uses ... Masks;
       
      ...
       
      function GSM7BitDefaultAlphabetToUnicode(AMessage: AnsiString; const UseGreekAlphabet: Boolean= False): Widestring; // Оригинал
       
        function InternalLookupChar(AGSMString: AnsiString;
                                    var AGSMStringCurrentIndex: Integer;
                                    var AUnicodeString: WideString;
                                    var AUnicodeStringCurrentIndex: Integer): Boolean;
        Begin
          Result := True;
          Case ord(aGSMString[aGSMStringCurrentIndex]) of
            $00: Begin
                   If aGSMStringCurrentIndex=length(aGSMString) then aUnicodeString[aUnicodeStringCurrentIndex] := WideChar($0000) // NULL (see note above)
                   else aUnicodeString[aUnicodeStringCurrentIndex] := WideChar($0040); // COMMERCIAL AT
                 end;
            $01: aUnicodeString[aUnicodeStringCurrentIndex] := WideChar($00A3); // POUND SIGN
            $02: aUnicodeString[aUnicodeStringCurrentIndex] := WideChar($0024); // DOLLAR SIGN
            $03: aUnicodeString[aUnicodeStringCurrentIndex] := WideChar($00A5); // YEN SIGN
            $04: aUnicodeString[aUnicodeStringCurrentIndex] := WideChar($00E8); // LATIN SMALL LETTER E WITH GRAVE
            $05: aUnicodeString[aUnicodeStringCurrentIndex] := WideChar($00E9); // LATIN SMALL LETTER E WITH ACUTE
            $06: aUnicodeString[aUnicodeStringCurrentIndex] := WideChar($00F9); // LATIN SMALL LETTER U WITH GRAVE
            $07: aUnicodeString[aUnicodeStringCurrentIndex] := WideChar($00EC); // LATIN SMALL LETTER I WITH GRAVE
            $08: aUnicodeString[aUnicodeStringCurrentIndex] := WideChar($00F2); // LATIN SMALL LETTER O WITH GRAVE
            $0A: aUnicodeString[aUnicodeStringCurrentIndex] := WideChar($000A); // LINE FEED
            $0B: aUnicodeString[aUnicodeStringCurrentIndex] := WideChar($00D8); // LATIN CAPITAL LETTER O WITH STROKE
            $0C: aUnicodeString[aUnicodeStringCurrentIndex] := WideChar($00F8); // LATIN SMALL LETTER O WITH STROKE
            $0D: aUnicodeString[aUnicodeStringCurrentIndex] := WideChar($000D); // CARRIAGE RETURN
            $0E: aUnicodeString[aUnicodeStringCurrentIndex] := WideChar($00C5); // LATIN CAPITAL LETTER A WITH RING ABOVE
            $0F: aUnicodeString[aUnicodeStringCurrentIndex] := WideChar($00E5); // LATIN SMALL LETTER A WITH RING ABOVE
            $10: aUnicodeString[aUnicodeStringCurrentIndex] := WideChar($0394); // GREEK CAPITAL LETTER DELTA
            $11: aUnicodeString[aUnicodeStringCurrentIndex] := WideChar($005F); // LOW LINE
            $12: aUnicodeString[aUnicodeStringCurrentIndex] := WideChar($03A6); // GREEK CAPITAL LETTER PHI
            $13: aUnicodeString[aUnicodeStringCurrentIndex] := WideChar($0393); // GREEK CAPITAL LETTER GAMMA
            $14: aUnicodeString[aUnicodeStringCurrentIndex] := WideChar($039B); // GREEK CAPITAL LETTER LAMDA
            $15: aUnicodeString[aUnicodeStringCurrentIndex] := WideChar($03A9); // GREEK CAPITAL LETTER OMEGA
            $16: aUnicodeString[aUnicodeStringCurrentIndex] := WideChar($03A0); // GREEK CAPITAL LETTER PI
            $17: aUnicodeString[aUnicodeStringCurrentIndex] := WideChar($03A8); // GREEK CAPITAL LETTER PSI
            $18: aUnicodeString[aUnicodeStringCurrentIndex] := WideChar($03A3); // GREEK CAPITAL LETTER SIGMA
            $19: aUnicodeString[aUnicodeStringCurrentIndex] := WideChar($0398); // GREEK CAPITAL LETTER THETA
            $1A: aUnicodeString[aUnicodeStringCurrentIndex] := WideChar($039E); // GREEK CAPITAL LETTER XI
            $1B: Begin
                   If (aGSMStringCurrentIndex < length(aGSMString)) then begin
                     inc(aGSMStringCurrentIndex);
                     case ord(aGSMString[aGSMStringCurrentIndex]) of
                       $0A: aUnicodeString[aUnicodeStringCurrentIndex] := WideChar($000C); // FORM FEED
                       $14: aUnicodeString[aUnicodeStringCurrentIndex] := WideChar($005E); // CIRCUMFLEX ACCENT
                       $28: aUnicodeString[aUnicodeStringCurrentIndex] := WideChar($007B); // LEFT CURLY BRACKET
                       $29: aUnicodeString[aUnicodeStringCurrentIndex] := WideChar($007D); // RIGHT CURLY BRACKET
                       $2F: aUnicodeString[aUnicodeStringCurrentIndex] := WideChar($005C); // REVERSE SOLIDUS
                       $3C: aUnicodeString[aUnicodeStringCurrentIndex] := WideChar($005B); // LEFT SQUARE BRACKET
                       $3D: aUnicodeString[aUnicodeStringCurrentIndex] := WideChar($007E); // TILDE
                       $3E: aUnicodeString[aUnicodeStringCurrentIndex] := WideChar($005D); // RIGHT SQUARE BRACKET
                       $40: aUnicodeString[aUnicodeStringCurrentIndex] := WideChar($007C); // VERTICAL LINE
                       $65: aUnicodeString[aUnicodeStringCurrentIndex] := WideChar($20AC); // EURO SIGN
                       else begin
                         dec(aGSMStringCurrentIndex);
                         aUnicodeString[aUnicodeStringCurrentIndex] := WideChar($00A0); // ESCAPE TO EXTENSION TABLE (or displayed as NBSP, see note above)
                       end;
                     end;
                   end
                   else aUnicodeString[aUnicodeStringCurrentIndex] := WideChar($00A0); // ESCAPE TO EXTENSION TABLE (or displayed as NBSP, see note above)
                 end;
            $1C: aUnicodeString[aUnicodeStringCurrentIndex] := WideChar($00C6); // LATIN CAPITAL LETTER AE
            $1D: aUnicodeString[aUnicodeStringCurrentIndex] := WideChar($00E6); // LATIN SMALL LETTER AE
            $1E: aUnicodeString[aUnicodeStringCurrentIndex] := WideChar($00DF); // LATIN SMALL LETTER SHARP S (German)
            $1F: aUnicodeString[aUnicodeStringCurrentIndex] := WideChar($00C9); // LATIN CAPITAL LETTER E WITH ACUTE
            $20: aUnicodeString[aUnicodeStringCurrentIndex] := WideChar($0020); // SPACE
            $21: aUnicodeString[aUnicodeStringCurrentIndex] := WideChar($0021); // EXCLAMATION MARK
            $22: aUnicodeString[aUnicodeStringCurrentIndex] := WideChar($0022); // QUOTATION MARK
            $23: aUnicodeString[aUnicodeStringCurrentIndex] := WideChar($0023); // NUMBER SIGN
            $24: aUnicodeString[aUnicodeStringCurrentIndex] := WideChar($00A4); // CURRENCY SIGN
            $25: aUnicodeString[aUnicodeStringCurrentIndex] := WideChar($0025); // PERCENT SIGN
            $26: aUnicodeString[aUnicodeStringCurrentIndex] := WideChar($0026); // AMPERSAND
            $27: aUnicodeString[aUnicodeStringCurrentIndex] := WideChar($0027); // APOSTROPHE
            $28: aUnicodeString[aUnicodeStringCurrentIndex] := WideChar($0028); // LEFT PARENTHESIS
            $29: aUnicodeString[aUnicodeStringCurrentIndex] := WideChar($0029); // RIGHT PARENTHESIS
            $2A: aUnicodeString[aUnicodeStringCurrentIndex] := WideChar($002A); // ASTERISK
            $2B: aUnicodeString[aUnicodeStringCurrentIndex] := WideChar($002B); // PLUS SIGN
            $2C: aUnicodeString[aUnicodeStringCurrentIndex] := WideChar($002C); // COMMA
            $2D: aUnicodeString[aUnicodeStringCurrentIndex] := WideChar($002D); // HYPHEN-MINUS
            $2E: aUnicodeString[aUnicodeStringCurrentIndex] := WideChar($002E); // FULL STOP
            $2F: aUnicodeString[aUnicodeStringCurrentIndex] := WideChar($002F); // SOLIDUS
            $30: aUnicodeString[aUnicodeStringCurrentIndex] := WideChar($0030); // DIGIT ZERO
            $31: aUnicodeString[aUnicodeStringCurrentIndex] := WideChar($0031); // DIGIT ONE
            $32: aUnicodeString[aUnicodeStringCurrentIndex] := WideChar($0032); // DIGIT TWO
            $33: aUnicodeString[aUnicodeStringCurrentIndex] := WideChar($0033); // DIGIT THREE
            $34: aUnicodeString[aUnicodeStringCurrentIndex] := WideChar($0034); // DIGIT FOUR
            $35: aUnicodeString[aUnicodeStringCurrentIndex] := WideChar($0035); // DIGIT FIVE
            $36: aUnicodeString[aUnicodeStringCurrentIndex] := WideChar($0036); // DIGIT SIX
            $37: aUnicodeString[aUnicodeStringCurrentIndex] := WideChar($0037); // DIGIT SEVEN
            $38: aUnicodeString[aUnicodeStringCurrentIndex] := WideChar($0038); // DIGIT EIGHT
            $39: aUnicodeString[aUnicodeStringCurrentIndex] := WideChar($0039); // DIGIT NINE
            $3A: aUnicodeString[aUnicodeStringCurrentIndex] := WideChar($003A); // COLON
            $3B: aUnicodeString[aUnicodeStringCurrentIndex] := WideChar($003B); // SEMICOLON
            $3C: aUnicodeString[aUnicodeStringCurrentIndex] := WideChar($003C); // LESS-THAN SIGN
            $3D: aUnicodeString[aUnicodeStringCurrentIndex] := WideChar($003D); // EQUALS SIGN
            $3E: aUnicodeString[aUnicodeStringCurrentIndex] := WideChar($003E); // GREATER-THAN SIGN
            $3F: aUnicodeString[aUnicodeStringCurrentIndex] := WideChar($003F); // QUESTION MARK
            $40: aUnicodeString[aUnicodeStringCurrentIndex] := WideChar($00A1); // INVERTED EXCLAMATION MARK
            $43: aUnicodeString[aUnicodeStringCurrentIndex] := WideChar($0043); // LATIN CAPITAL LETTER C
            $44: aUnicodeString[aUnicodeStringCurrentIndex] := WideChar($0044); // LATIN CAPITAL LETTER D
            $46: aUnicodeString[aUnicodeStringCurrentIndex] := WideChar($0046); // LATIN CAPITAL LETTER F
            $47: aUnicodeString[aUnicodeStringCurrentIndex] := WideChar($0047); // LATIN CAPITAL LETTER G
            $4A: aUnicodeString[aUnicodeStringCurrentIndex] := WideChar($004A); // LATIN CAPITAL LETTER J
            $4C: aUnicodeString[aUnicodeStringCurrentIndex] := WideChar($004C); // LATIN CAPITAL LETTER L
            $51: aUnicodeString[aUnicodeStringCurrentIndex] := WideChar($0051); // LATIN CAPITAL LETTER Q
            $52: aUnicodeString[aUnicodeStringCurrentIndex] := WideChar($0052); // LATIN CAPITAL LETTER R
            $53: aUnicodeString[aUnicodeStringCurrentIndex] := WideChar($0053); // LATIN CAPITAL LETTER S
            $56: aUnicodeString[aUnicodeStringCurrentIndex] := WideChar($0056); // LATIN CAPITAL LETTER V
            $57: aUnicodeString[aUnicodeStringCurrentIndex] := WideChar($0057); // LATIN CAPITAL LETTER W
            $59: aUnicodeString[aUnicodeStringCurrentIndex] := WideChar($0059); // LATIN CAPITAL LETTER Y
            $5B: aUnicodeString[aUnicodeStringCurrentIndex] := WideChar($00C4); // LATIN CAPITAL LETTER A WITH DIAERESIS
            $5C: aUnicodeString[aUnicodeStringCurrentIndex] := WideChar($00D6); // LATIN CAPITAL LETTER O WITH DIAERESIS
            $5D: aUnicodeString[aUnicodeStringCurrentIndex] := WideChar($00D1); // LATIN CAPITAL LETTER N WITH TILDE
            $5E: aUnicodeString[aUnicodeStringCurrentIndex] := WideChar($00DC); // LATIN CAPITAL LETTER U WITH DIAERESIS
            $5F: aUnicodeString[aUnicodeStringCurrentIndex] := WideChar($00A7); // SECTION SIGN
            $60: aUnicodeString[aUnicodeStringCurrentIndex] := WideChar($00BF); // INVERTED QUESTION MARK
            $61: aUnicodeString[aUnicodeStringCurrentIndex] := WideChar($0061); // LATIN SMALL LETTER A
            $62: aUnicodeString[aUnicodeStringCurrentIndex] := WideChar($0062); // LATIN SMALL LETTER B
            $63: aUnicodeString[aUnicodeStringCurrentIndex] := WideChar($0063); // LATIN SMALL LETTER C
            $64: aUnicodeString[aUnicodeStringCurrentIndex] := WideChar($0064); // LATIN SMALL LETTER D
            $65: aUnicodeString[aUnicodeStringCurrentIndex] := WideChar($0065); // LATIN SMALL LETTER E
            $66: aUnicodeString[aUnicodeStringCurrentIndex] := WideChar($0066); // LATIN SMALL LETTER F
            $67: aUnicodeString[aUnicodeStringCurrentIndex] := WideChar($0067); // LATIN SMALL LETTER G
            $68: aUnicodeString[aUnicodeStringCurrentIndex] := WideChar($0068); // LATIN SMALL LETTER H
            $69: aUnicodeString[aUnicodeStringCurrentIndex] := WideChar($0069); // LATIN SMALL LETTER I
            $6A: aUnicodeString[aUnicodeStringCurrentIndex] := WideChar($006A); // LATIN SMALL LETTER J
            $6B: aUnicodeString[aUnicodeStringCurrentIndex] := WideChar($006B); // LATIN SMALL LETTER K
            $6C: aUnicodeString[aUnicodeStringCurrentIndex] := WideChar($006C); // LATIN SMALL LETTER L
            $6D: aUnicodeString[aUnicodeStringCurrentIndex] := WideChar($006D); // LATIN SMALL LETTER M
            $6E: aUnicodeString[aUnicodeStringCurrentIndex] := WideChar($006E); // LATIN SMALL LETTER N
            $6F: aUnicodeString[aUnicodeStringCurrentIndex] := WideChar($006F); // LATIN SMALL LETTER O
            $70: aUnicodeString[aUnicodeStringCurrentIndex] := WideChar($0070); // LATIN SMALL LETTER P
            $71: aUnicodeString[aUnicodeStringCurrentIndex] := WideChar($0071); // LATIN SMALL LETTER Q
            $72: aUnicodeString[aUnicodeStringCurrentIndex] := WideChar($0072); // LATIN SMALL LETTER R
            $73: aUnicodeString[aUnicodeStringCurrentIndex] := WideChar($0073); // LATIN SMALL LETTER S
            $74: aUnicodeString[aUnicodeStringCurrentIndex] := WideChar($0074); // LATIN SMALL LETTER T
            $75: aUnicodeString[aUnicodeStringCurrentIndex] := WideChar($0075); // LATIN SMALL LETTER U
            $76: aUnicodeString[aUnicodeStringCurrentIndex] := WideChar($0076); // LATIN SMALL LETTER V
            $77: aUnicodeString[aUnicodeStringCurrentIndex] := WideChar($0077); // LATIN SMALL LETTER W
            $78: aUnicodeString[aUnicodeStringCurrentIndex] := WideChar($0078); // LATIN SMALL LETTER X
            $79: aUnicodeString[aUnicodeStringCurrentIndex] := WideChar($0079); // LATIN SMALL LETTER Y
            $7A: aUnicodeString[aUnicodeStringCurrentIndex] := WideChar($007A); // LATIN SMALL LETTER Z
            $7B: aUnicodeString[aUnicodeStringCurrentIndex] := WideChar($00E4); // LATIN SMALL LETTER A WITH DIAERESIS
            $7C: aUnicodeString[aUnicodeStringCurrentIndex] := WideChar($00F6); // LATIN SMALL LETTER O WITH DIAERESIS
            $7D: aUnicodeString[aUnicodeStringCurrentIndex] := WideChar($00F1); // LATIN SMALL LETTER N WITH TILDE
            $7E: aUnicodeString[aUnicodeStringCurrentIndex] := WideChar($00FC); // LATIN SMALL LETTER U WITH DIAERESIS
            $7F: aUnicodeString[aUnicodeStringCurrentIndex] := WideChar($00E0); // LATIN SMALL LETTER A WITH GRAVE
            $09: aUnicodeString[aUnicodeStringCurrentIndex] := WideChar($00E7); // LATIN SMALL LETTER C WITH CEDILLA
            //$09: aUnicodeString[aUnicodeStringCurrentIndex] := WideChar($00C7); // LATIN CAPITAL LETTER C WITH CEDILLA (see note above)
            $41: begin
                   if not UseGreekAlphabet then aUnicodeString[aUnicodeStringCurrentIndex] := WideChar($0041) // LATIN CAPITAL LETTER A
                   else aUnicodeString[aUnicodeStringCurrentIndex] := WideChar($0391); // GREEK CAPITAL LETTER ALPHA
                 end;
            $42: begin
                   if not UseGreekAlphabet then aUnicodeString[aUnicodeStringCurrentIndex] := WideChar($0042) // LATIN CAPITAL LETTER B
                   else aUnicodeString[aUnicodeStringCurrentIndex] := WideChar($0392); // GREEK CAPITAL LETTER BETA
                 end;
            $45: begin
                   if not UseGreekAlphabet then aUnicodeString[aUnicodeStringCurrentIndex] := WideChar($0045) // LATIN CAPITAL LETTER E
                   else aUnicodeString[aUnicodeStringCurrentIndex] := WideChar($0395); // GREEK CAPITAL LETTER EPSILON
                 end;
            $48: begin
                   if not UseGreekAlphabet then aUnicodeString[aUnicodeStringCurrentIndex] := WideChar($0048) // LATIN CAPITAL LETTER H
                   else aUnicodeString[aUnicodeStringCurrentIndex] := WideChar($0397); // GREEK CAPITAL LETTER ETA
                 end;
            $49: begin
                   if not UseGreekAlphabet then aUnicodeString[aUnicodeStringCurrentIndex] := WideChar($0049) // LATIN CAPITAL LETTER I
                   else aUnicodeString[aUnicodeStringCurrentIndex] := WideChar($0399); // GREEK CAPITAL LETTER IOTA
                 end;
            $4B: begin
                   if not UseGreekAlphabet then aUnicodeString[aUnicodeStringCurrentIndex] := WideChar($004B) // LATIN CAPITAL LETTER K
                   else aUnicodeString[aUnicodeStringCurrentIndex] := WideChar($039A); // GREEK CAPITAL LETTER KAPPA
                 end;
            $4D: begin
                   if not UseGreekAlphabet then aUnicodeString[aUnicodeStringCurrentIndex] := WideChar($004D) // LATIN CAPITAL LETTER M
                   else aUnicodeString[aUnicodeStringCurrentIndex] := WideChar($039C); // GREEK CAPITAL LETTER MU
                 end;
            $4E: begin
                   if not UseGreekAlphabet then aUnicodeString[aUnicodeStringCurrentIndex] := WideChar($004E) // LATIN CAPITAL LETTER N
                   else aUnicodeString[aUnicodeStringCurrentIndex] := WideChar($039D); // GREEK CAPITAL LETTER NU
                 end;
            $4F: begin
                   if not UseGreekAlphabet then aUnicodeString[aUnicodeStringCurrentIndex] := WideChar($004F) // LATIN CAPITAL LETTER O
                   else aUnicodeString[aUnicodeStringCurrentIndex] := WideChar($039F); // GREEK CAPITAL LETTER OMICRON
                 end;
            $50: begin
                   if not UseGreekAlphabet then aUnicodeString[aUnicodeStringCurrentIndex] := WideChar($0050) // LATIN CAPITAL LETTER P
                   else aUnicodeString[aUnicodeStringCurrentIndex] := WideChar($03A1); // GREEK CAPITAL LETTER RHO
                 end;
            $54: begin
                   if not UseGreekAlphabet then aUnicodeString[aUnicodeStringCurrentIndex] := WideChar($0054) // LATIN CAPITAL LETTER T
                   else aUnicodeString[aUnicodeStringCurrentIndex] := WideChar($03A4); // GREEK CAPITAL LETTER TAU
                 end;
            $55: begin
                   if not UseGreekAlphabet then aUnicodeString[aUnicodeStringCurrentIndex] := WideChar($0055) // LATIN CAPITAL LETTER U
                   else aUnicodeString[aUnicodeStringCurrentIndex] := WideChar($03A5); // GREEK CAPITAL LETTER UPSILON
                 end;
            $58: begin
                   if not UseGreekAlphabet then aUnicodeString[aUnicodeStringCurrentIndex] := WideChar($0058) // LATIN CAPITAL LETTER X
                   else aUnicodeString[aUnicodeStringCurrentIndex] := WideChar($03A7); // GREEK CAPITAL LETTER CHI
                 end;
            $5A: begin
                   if not UseGreekAlphabet then aUnicodeString[aUnicodeStringCurrentIndex] := WideChar($005A) // LATIN CAPITAL LETTER Z
                   else aUnicodeString[aUnicodeStringCurrentIndex] := WideChar($0396); // GREEK CAPITAL LETTER ZETA
                 end;
            else Result := False;
          end;
          If Result then Inc(AUnicodeStringCurrentIndex);
        end;
       
      Var ResultCurrentIndex: Integer;
          FMessageCurrentIndex: Integer;
      Begin
      SetLength(Result, S_Length(AMessage));
      ResultCurrentIndex := 1; FMessageCurrentIndex := 1;
      While FMessageCurrentIndex <= S_Length(AMessage) do
        Begin
        If not InternalLookupChar(AMessage,FMessageCurrentIndex, Result, ResultCurrentIndex) then
          Begin
          Result[ResultCurrentIndex] := WideChar($0020);
          Inc(ResultCurrentIndex);
          End;
        Inc(FMessageCurrentIndex);
        End;
      SetLength(Result, ResultCurrentIndex - 1);
      End;
       
       
      ...
       
      function ucs2(src: string): string;        // Результат СМС знаки: цифры, собачка, греческие. Аналогично 7 bit
      var i, k: integer;
      begin
      for i:= 1 to length(src) do begin
        k:= ord(src[i]);
        if k >= 192 then k:= k + 1040 - 192;
        result:= result + inttohex(k, 4)
      end
      end;
       
       
      function Encode7bit(Src: String): String;   // Результат СМС знаки: цифры, собачка, греческие.
      var Dst:String;
          i:Integer;
          CurS,NextS:Byte;
          TStr:String;
      begin
        for i:=1 to Length(Src) do begin
          if (i mod 8)=0 then Continue;
          TStr:=Copy(Src,i,1);
          CurS:=Ord(TStr[1]);
          if (i mod 8)>1 then
            CurS:=(CurS shr ((i mod 8)-1) );
          if i < Length(Src) then begin
            TStr:= Copy(Src, i + 1, 1);
            NextS:= Ord(TStr[1]);
          end else
            NextS:=0;
          NextS:=(NextS shl (8-(i mod 8)));
          Dst:=Dst + IntToHex(CurS+NextS,2);
        end;
        Result:= Dst;
      end;
       
       
      function TShSMS.MessageEncode(ACenter, AAddress, AMessage: AnsiString): AnsiString;
       
      function InternalStringToPDU(S: AnsiString): AnsiString;
      Var  InX, InLen, OutLen, OutPos: Integer;
           RoundUp: Boolean;
           TempByte, NextByte: Byte;
      Begin
      If S = Ch_Free then Exit;
      OutPos := 1;
      InLen := S_Length(S);
      If InLen > 160 then Exit;// Raise TException.Create('Input string greater than 160 characters!');
      RoundUp := (InLen * 7 mod 8) <> 0;
      OutLen := InLen * 7 div 8;
      If RoundUp then Inc(OutLen);
      SetLength(Result, OutLen);
      For InX := 1 to InLen do
        Begin
        TempByte := Byte(S[InX]);
        If ((TempByte and $80) <> 0) then Break;// Raise TException.Create('Input string contains 8-bit data!');
        If (InX < InLen) then NextByte := Byte(S[InX + 1]) Else NextByte := 0;
        TempByte := TempByte shr ((InX - 1) mod 8);
        NextByte := NextByte shl (8 - ((InX) mod 8));
        TempByte := TempByte or NextByte;
        Result[OutPos] := AnsiChar(TempByte);
        If InX mod 8 <> 0 then Inc(OutPos);
        End;
      End;
       
      Var FLength, InX: Integer;
          S: AnsiString;
      Begin
      If (ACenter <> Ch_Free) and (ACenter[1] = Ch_Plus) then Delete(ACenter, 1, 1);
      If (AAddress <> Ch_Free) and (AAddress[1] = Ch_Plus) then Delete(AAddress, 1, 1);
      If ACenter = Ch_Free then Result := '00' Else
        Begin
        FLength := S_Length(ACenter);
        If Odd(FLength) then FLength := FLength + 1;
        FLength := 1 + (FLength Div 2);
        If FLength < 10 then Result := '0' + IntToStr(FLength) Else Result := IntToStr(FLength);
        Result := Result + '91';
        FLength := S_Length(ACenter);
        InX := 1;
        While InX < FLength do
          Begin
          Result := Result + ACenter[InX + 1] + ACenter[InX];
          InX := InX + 2;
          End;
        If Odd(FLength) then Result := Result + 'F' + ACenter[FLength];
        End;
      Result := Result + '11';
      Result := Result + '00';
      Result := Result + Format('%02.2x', [S_Length(AAddress)]);
      Result := Result + '91';
      FLength := S_Length(AAddress);
      InX := 1;
      While InX < FLength do
        Begin
        Result := Result + AAddress[InX + 1] + AAddress[InX];
        InX := InX + 2;
        End;
      If Odd(FLength) then Result := Result + 'F' + AAddress[FLength];
      Result := Result + '00';
      Result := Result + '00';
      Result := Result + 'AA';
      Result := Result + Format('%02.2x', [S_Length(AMessage)]);
      S := InternalStringToPDU(AMessage);
      //S := ucs2(AMessage);                        // Изменил на ucs2, результат отрицательный
      //S := Encode7bit(AMessage);               // Изменил на Encode7bit, результат отрицательный
       
      For InX := 1 to S_Length(S) do Result := Result + IntToHex(Byte(S[InX]), 2);
      End;
       
       
      procedure TShSMS.MessageDecode(AValue: AnsiString; var ACenter, AAddress, AMessage: AnsiString);
      function InternalPDUToString(S: AnsiString): AnsiString;
      Var  InX, InLen, OutLen, OutPos: Integer;
           TempByte, PrevByte : Byte;
      Begin
      If S = Ch_Free then Exit;
      PrevByte := 0; OutPos := 1;
      InLen := S_Length(S);
      Assert(InLen <= 140, 'Input string greater than 140 characters');
      OutLen := (InLen * 8) div 7;
      SetLength(Result, OutLen);
      For InX := 1 to InLen do
        Begin
        TempByte := Byte(S[InX]);
        TempByte := TempByte and not ($FF shl (7 - ((InX - 1) mod 7)));
        TempByte := TempByte shl ((InX - 1) mod 7);
        TempByte := TempByte or PrevByte;
        Result[OutPos] := AnsiChar(TempByte);
        Inc(OutPos);
        PrevByte := Byte(S[InX]);
        PrevByte := PrevByte shr (7 - ((InX - 1) mod 7));
        If (InX mod 7) = 0 then
          Begin
          Result[OutPos] := AnsiChar(PrevByte);
          Inc(OutPos);
          PrevByte := 0;
          End;
        End;
      If Result[Length(Result)] = #0 then Result := S_CopyStr(Result, 1, Pred(S_Length(Result)));
      End;
       
      Var FLength, InX: Integer;
          S: AnsiString;
      Begin
      ACenter := Ch_Free; AAddress := Ch_Free; AMessage := Ch_Free;
      InX := 1;
      FLength := StrToInt(S_CopyStr(AValue, InX, 2));
      Inc(InX, 2);
      If FLength > 0 then
        Begin
        Inc(InX, 2);
        While InX < (FLength * 2 + 3) do
          Begin
          If AValue[InX] = 'F' then ACenter := ACenter + AValue[InX + 1] Else ACenter := ACenter + AValue[InX + 1] + AValue[InX];
          Inc(InX, 2);
          End;
        End;
      Inc(InX, 2);
      FLength := (StrToInt('$' + S_CopyStr(AValue, InX, 2)));
      Inc(InX, 2);
      Inc(InX, 2);
      If Odd(FLength) then Inc(FLength, 1);
      FLength := FLength + InX;
      While InX < (FLength) do
        Begin
        If AValue[InX] = 'F' then AAddress := AAddress + AValue[InX + 1] Else AAddress := AAddress + AValue[InX + 1] + AValue[InX];
        Inc(InX, 2);
        End;
      Inc(InX, 2);
      Inc(InX, 2);
      Inc(InX, 14);
      Inc(InX, 2);
      FLength := S_Length(AValue);
      S := Ch_Free;
      While InX <= FLength do
        Begin
        S := S + AnsiChar(StrToInt(AnsiChar('$') + AnsiChar(AValue[InX]) + AnsiChar(AValue[InX + 1])));
        Inc(InX, 2);
        End;
      AMessage := InternalPDUToString(S);
      //AMessage := ucs2(AMessage);                        // Изменил на ucs2, результат отрицательный
      //AMessage := Encode7bit(AMessage);                  // Изменил на Encode7bit, результат отрицательный
      End;
       
      ...
       
      function TShSMS.AllMessage(AList: TStringList): Boolean;
      Var  FList: TStringList;
           InX: Integer;
           FMemStorage, FMessageCode, FCenter, FAdress, FMessage: AnsiString;
      Begin
      With FSMS do
        Begin
        FList := TStringList.Create;
        Result := Assigned(AList) and
                  SMSList(FList) and
                  SMSList(FList, '"ME"') and
                  (FList.Count > 0);
        If Result then
          Begin
          AList.Clear;
          For InX := 0 to FList.Count - 1 do
            Begin
            FMessageCode := S_Cut(FList.ValueFromIndex[InX], 1);
            FMemStorage := S_Cut(FList.ValueFromIndex[InX], 2);
            MessageDecode(FMessageCode, FCenter, FAdress, FMessage);
            FMessage := GSM7BitDefaultAlphabetToUnicode(FMessage);
            AList.Add(FList.Names[InX] + Ch_Equal + FAdress + Ch_Spec + FMessage + Ch_Spec + FMemStorage);
            End;
          Result := AList.Count > 0;
          End;
        FList.Free;
        End;
      End;
       
      ...
       
      function TShSMS.SMSSendPDU(ASMSCenter, ASMSAddress, AMessage: AnsiString; AEncode: Boolean = True): Boolean;
      Var  FLength: Integer;
           Str: AnsiString;
      begin
      With FSMS do If not SendWait and Connected then
        Begin
        SendWait := True;
        Result := SendCmd(#27) and
                  SendCmd('AT'#13) and
                  GetATCmdOkResponse and
                  SendCmd('AT+CMGF=0'#13) and
                  GetATCmdOkResponse and
                  ((ASMSCenter = Ch_Free) or (SendCmd('AT+CSCA="' + ASMSCenter + '"'#13) and GetATCmdOkResponse));
        If Result then
          Begin
          If AEncode then AMessage := MessageEncode(ASMSCenter, ASMSAddress, AMessage);   // Оригинал
         //If AEncode then AMessage := Ucs2(AMessage);     // Изменил на ucs2, СМС не отправляется
       
          Str := S_CopyStr(AMessage, 1, 2);
          If not TryStrToInt(Str, FLength) then FLength := 0;
          FLength := (S_Length(AMessage) div 2) - FLength - 1;
          Result := SendCmd('AT+CMGS=' + IntToStr(FLength) + #13) and
                    GetATCmdLineFeedResponse and
                    SendCmd(AMessage + #26);
          If Result then
            Begin
            Application.ProcessMessages;
            OS_Delay(100, 10);
            GetATCmdOkResponse;
            End;
          End;
        SendWait := False;
        End;
      end;
       
      ...
       
      end;
    min@y™
    Сообщ. #2 ,
      Full Member
      ***
      Профиль · PM
      Рейтинг (т): 10
      а как непосредственно перед отправкой буфер символов выглядит в отладчике?
      Massaget
      Сообщ. #3 ,
        Newbie
        Профиль · PM
        Рейтинг (т): нет
        Сообщение отобразилось корректно.

        ExpandedWrap disabled
          function SendTo(ATo, AMessage: String): Boolean;
          Begin
           
          Result := (Trim(ATo) <> Ch_Free) and (Trim(AMessage) <> Ch_Free) and Open and
                    SMSSendPDU(Ch_Free, Ch_Plus + IntToStr(PhoneNumberStringToInt64(ATo)), S_Copy(Trim(AMessage), 1, 160));
          ShowMessage('SendTo: ' + AMessage); // Текст СМС отобразился корректно.
          End;


        ShowMessage не отобразился. Не знаю как здесь обстановка.
        ExpandedWrap disabled
          function SMSSendText(ASMSCenter, ASMSAddress, AMessage: AnsiString; ACharset: AnsiString = Ch_Free): Boolean;
          begin
          ShowMessage('SMSSendText: ' + AMessage);
          With FSMS do If Connected then
            Begin
            Result := SendCmd(#27) and
                      SendCmd('AT'#13) and
                      GetATCmdOkResponse and
                      SendCmd('AT+CMGF=1'#13) and
                      GetATCmdOkResponse and
                      ((ASMSCenter = Ch_Free) or (SendCmd('AT+CSCA="' + ASMSCenter + '"'#13) and GetATCmdOkResponse)) and
                      ((ACharset = Ch_Free) or (SendCmd('AT+CSCS="' + ACharset + '"'#13) and GetATCmdOkResponse)) and
                      SendCmd('AT+CMGS="' + ASMSAddress + '"'+#13) and
                      GetATcmdlinefeedResponse and
                      SendCmd(AMessage + #26);
              If Result then
                Begin
                Application.ProcessMessages;
                OS_Delay(100, 20);
                End;
                      //GetATCmdOkResponse;
            End;
          end;
        raxp
        Сообщ. #4 ,
          Full Member
          ***
          Профиль · PM
          Рейтинг (т): 19
          Почитайте про формат PDU.
          min@y™
          Сообщ. #5 ,
            Full Member
            ***
            Профиль · PM
            Рейтинг (т): 10
            Цитата Massaget @
            ShowMessage не отобразился. Не знаю как здесь обстановка.

            а как непосредственно перед отправкой буфер символов выглядит в отладчике?
            Massaget
            Сообщ. #6 ,
              Newbie
              Профиль · PM
              Рейтинг (т): нет
              Уважаемый raxp, сказать по правде, я долго ждал именно Вашего ответа! Можно сказать как ребёнок маму :). Потому что, многие источники указывали именно на Ваши статьи / посты. Конечно материалы по Вашей ссылке и многие другие у меня присутствуют. Собрал также немало проектов с исходниками. Но все так или иначе стабильно и полнофункционально не работают. Увы, мне тяжело даётся чужой код, который ещё не содержит подробных комментариев. Особенно я запутался в кодирование номера получателя и синтаксиса мультипарт. Кое как в своём текстовом проекте реализовал отправку кирилицы и латиницы. Отправляет через раз, иногда вообще не отправляет. Хотел добавить мультипарт, и стабильное отправление СМС вместе с полноценными таймаутами между командами инициализации модема, но не осилил.
              Пришлось юзать чужой компонент, который тоже не без иъяна.
              В общем мне нужно воедино собрать софт отправляющие латиницу и кирилицу с поддержкой мультипарт. Буду очень рад, если поможе с моими исходниками либо поделитесь своими рабочими. Само собой полученное Вами никуда не всплывёт. Сам по такому условию получил пару тройку проектов.

              Добавлено
              min@y™
              Цитата
              а как непосредственно перед отправкой буфер символов выглядит в отладчике?

              Похоже, что я не совсем понял о чём речь. Вы могли бы уточнить действия, которые мне необходимо выполнить для этого?
              min@y™
              Сообщ. #7 ,
                Full Member
                ***
                Профиль · PM
                Рейтинг (т): 10
                Цитата Massaget @
                Похоже, что я не совсем понял о чём речь. Вы могли бы уточнить действия, которые мне необходимо выполнить для этого?

                ну, если так, то забей, проехали.
                raxp
                Сообщ. #8 ,
                  Full Member
                  ***
                  Профиль · PM
                  Рейтинг (т): 19
                  http://raxp2.blogspot.com/2015/04/api-smspdudll.html
                  https://sourceforge.net/projects/smspdu/fil...latest/download
                  Massaget
                  Сообщ. #9 ,
                    Newbie
                    Профиль · PM
                    Рейтинг (т): нет
                    raxp, благодарю за ссылки! Кстати они у меня тоже есть. В своё время тоже пытался использовать вашу библиотеку. Но из-за ошибок при компиляции, так и не довёл до конца.
                    Буду рад, если поделитесь рабочим работающим проектом с вашей ддлкой! Т.е. мне самому долго делать, а мне нужно быстро собрать проверить работоспособность.
                    Сообщение отредактировано: Massaget -
                    raxp
                    Сообщ. #10 ,
                      Full Member
                      ***
                      Профиль · PM
                      Рейтинг (т): 19
                      ...а мое время значит не в счет?

                      ExpandedWrap disabled
                             ' регистрируем COM объект DynamicWrapperX в тихом режиме
                            Dim WshShell
                            Set WshShell = WScript.CreateObject("WScript.Shell")
                            WshShell.Run ("regsvr32.exe dynwrapx.dll /s"),3, true
                         
                            ' создаем объект DynamicWrapperX.2
                            Set Wrap = CreateObject("DynamicWrapperX.2")
                            Wrap.Register "smspdu.dll", "pdu", "i=sssssll", "f=s", "r=s"
                            MSGBOX Wrap.pdu("COM1", "+38063", "9010000", "+380505930593", "Тест SMS", 0, 0)

                      VBS работает из коробки, компилировать ничего не надо.
                      Massaget
                      Сообщ. #11 ,
                        Newbie
                        Профиль · PM
                        Рейтинг (т): нет
                        Цитата
                        ...а мое время значит не в счет?

                        И в мыслях не было такое подумать.

                        Мопед сидит на след. портах: 38 (3G Application Interface), 39 (3G PC UI Interface), 48 (сам модем).
                        Запустил батник: regdynwrapx.bat.
                        Корректировал строчку MSGBOX Wrap.pdu("COM1", "+38063", "9010000", "+380505930593", "Тест SMS", 0, 0) под свои параметры и запустил.
                        Результат: Port is busy or does exist. Порты существуют и не заняты, в чём может быть ошибка?
                        Сообщение отредактировано: Massaget -
                        raxp
                        Сообщ. #12 ,
                          Full Member
                          ***
                          Профиль · PM
                          Рейтинг (т): 19
                          ...порты выше девятого следует записывать как \\\\.\\COM38
                          к примеру.
                          Massaget
                          Сообщ. #13 ,
                            Newbie
                            Профиль · PM
                            Рейтинг (т): нет
                            Пробовал так.
                            Для runsmspdu.vbs:
                            ExpandedWrap disabled
                              MSGBOX Wrap.pdu("\\\\.\\COM46", "+99890", "1850488", "+99893ааахххх", "Тест  SMS", 0, 0).


                            Для Делфи-проекта:
                            ExpandedWrap disabled
                              procedure TForm1.Button3Click(Sender: TObject);
                              begin
                              //pdu('COM3', '+38063', '9010000', '+380671333491', 'Тест SMS', 0);
                              //pdu('\\\\.\\COM46', '+99890', '1850488', '+99893ааахххх', 'Тест SMS, COM46, PSMSPDU.exe', 0); // Не шлёт СМС
                              pdu('\\\.\\COM46', '+99890', '1850488', '+99893ааахххх', 'Тест SMS, COM46, PSMSPDU.exe', 0); // Не шлёт СМС
                              //pdu(PAnsiChar(LabeledEdit4.Text), PAnsiChar(LabeledEdit2), PAnsiChar(LabeledEdit3), PAnsiChar(LabeledEdit1.Text), PAnsiChar(Memo2.Text), 0);
                              end;


                            СМС не шлются ни в одном из методов.
                            Сообщение отредактировано: Massaget -
                            raxp
                            Сообщ. #14 ,
                              Full Member
                              ***
                              Профиль · PM
                              Рейтинг (т): 19
                              ...в первом варианте возможно ошиблись с записью номера центра. Во втором - неверное количество слешей и на один параметр меньше в функции экспорта.
                              1 пользователей читают эту тему (1 гостей и 0 скрытых пользователей)
                              0 пользователей:


                              Рейтинг@Mail.ru
                              [ Script execution time: 0.0916 ]   [ 15 queries used ]   [ Generated: 23.08.26, 22:45 GMT ]  
                              Powered by Invision Power Board(U) v1.2 © 2003  IPS, Inc.