⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 sm_msgp.pas

📁 SM_Msg.rar 手机短信发送程序
💻 PAS
📖 第 1 页 / 共 4 页
字号:
  Y: Integer);
var
  AttachMode: TNodeAttachMode;
  HT: THitTests;
begin
  if TV_PhoneNote.Selected = nil then Exit;
  HT := TV_PhoneNote.GetHitTestInfoAt(X, Y);
  RootNode := TV_PhoneNote.GetNodeAt(X, Y);
  if (HT - [htOnItem, htOnIcon, htNowhere, htOnIndent] <> HT) then 
  begin
    if (htOnItem in HT) or (htOnIcon in HT) then AttachMode := naAddChild
    else if htNowhere in HT then AttachMode := naAdd

    else if htOnIndent in HT then AttachMode := naInsert;
    TV_PhoneNote.Selected.MoveTo(RootNode, AttachMode);
  end;
end;

procedure TfrmSM_Msg.TV_PhoneNoteDragOver(Sender, Source: TObject; X,
  Y: Integer; State: TDragState; var Accept: Boolean);
begin
  Accept:=sender=source;
    if y<10 then
    PostMessage(TV_PhoneNote.handle,WM_VScroll,SB_LINEUp,0)
  else if TV_PhoneNote.Height-y<10 then
    PostMessage(TV_PhoneNote.handle,WM_VScroll,SB_LINEDOWN    ,0)
end;

procedure TfrmSM_Msg.sgrdStringDrawCell(Sender: TObject; ACol,
  ARow: Integer; Rect: TRect; State: TGridDrawState);
var
  OldAlign,
  OldBkMode,
  OldTextColor:Integer;
  Text_Height, X, Y:Integer;
begin
  Inherited;
  with sgrdString.Canvas do
  begin
    if ((ACol=1)or(ACol=2))and(State=[]) then
      Font.Color:=clBlack;
    FillRect(Rect);
    OldBkMode:=SetBkMode(Handle, Transparent);
    OldAlign:=SetTextAlign(Handle, TA_Center);
    Text_Height:=TextHeight('Test');
    X:=(Rect.Left+Rect.Right) div 2+1;
    Y:=(Rect.Bottom+Rect.Top-Text_Height) div 2;
    if Y<0 then Y:=0;
    OldTextColor:=Font.Color;
    if (ARow=0)or(ACol=0) then
    begin
      Font.Color:=clWhite;
      TextOut(X+1, Y+1, sgrdString.Cells[ACol, ARow]);
    end;
    Font.Color:=OldTextColor;
    TextOut(X, Y, sgrdString.Cells[ACol, ARow]);
    SetTextAlign(Handle, OldAlign);
    SetBkMode(Handle, OldBkMode);
  end;
end;

procedure TfrmSM_Msg.sgrdStringExit(Sender: TObject);
var
 s:string;
begin
//PostMessage(sgrdString.Handle, wm_KeyDown, vk_Escape, 0);
 if (sgrdstring_State=stEdit) then
   begin
    s:=Trim(sgrdstring.Cells[2,sgrdstring.Row]);
    sgrdstring.Cells[1,sgrdstring.Row]:=SearchPhoneNote(s);
   end;
end;

procedure TfrmSM_Msg.sgrdStringKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
var
  s:string;
begin
  // 取消所做的修改
if (Key=VK_RETURN)and(sgrdString_State=stEdit) then
 begin
  s:=Trim(sgrdstring.Cells[2,sgrdstring.Row]);
  sgrdstring.Cells[1,sgrdstring.Row]:=SearchPhoneNote(s);
  if sgrdstring.Row<sgrdString.RowCount then sgrdstring.Row:=sgrdstring.Row+1;
 end;
if (sgrdString_State<>stBrowse)and(Key=vk_Escape) then
 begin
  if (sgrdString_State=stEdit) then
     sgrdString.Cells[2, sgrdString.Row]:=F_OldMobilePhone;
{  if (sgrdString_State=stInsert) then
   begin
    sgrdString.Cells[1, sgrdString.Row]:='';
    sgrdString.Cells[2, sgrdString.Row]:='';
   end;}
  sgrdString_State:=stBrowse;
 end;
end;

procedure TfrmSM_Msg.sgrdStringSelectCell(Sender: TObject; ACol,
  ARow: Integer; var CanSelect: Boolean);
var
 s:string;
begin
try
if (sgrdString_State<>stBrowse)and(ARow<>sgrdString.Row) then
if Trim(sgrdString.Cells[2,sgrdstring.Row])<>'' then
  if CheckPhone(11,sgrdString.Cells[2,sgrdstring.Row]) then
    begin
     s:=Trim(sgrdString.Cells[2,sgrdstring.Row]);
     sgrdString.Cells[1,sgrdstring.Row]:=SearchPhoneNote(s);
    end else
    begin
     sgrdString.Cells[1,sgrdstring.Row]:=SearchPhoneNote(s);
     ErrorMsg(1,'无效的手机号码!');
    end;
if (ARow<>sgrdString.Row) then
 sgrdString_State:=stBrowse;
if (ARow<>sgrdString.Row) then
begin
 
end;
except
 on E:Exception do
  begin
   sgrdString.SetFocus;
   Application.MessageBox(PChar(E.Message), '错误信息', mb_IconError+mb_Ok);
   Abort;
  end;
end;
if ACol=3 then
 begin
 CanSelect:=True;
 if Trim(sgrdString.Cells[3,ARow])='' then
   sgrdString.Cells[3,ARow]:='√' else
   sgrdString.Cells[3,ARow]:='';
 CanSelect:=False;
 end;
if ACol=1 then CanSelect:=False;
end;

procedure TfrmSM_Msg.bit_SearchClick(Sender: TObject);
var
 i:integer;
begin
for i:=1 to sgrdString.RowCount do
 if (Trim(sgrdstring.Cells[3,i])='') and
  (Trim(sgrdstring.Cells[2,i])<>'') then
   sgrdstring.Cells[3,i]:='√';
end;

procedure TfrmSM_Msg.bit_SearchOnClick(Sender: TObject);
var
 frmSearch:TfrmSearch;
begin
frmSearch:=TfrmSearch.Create(self);
frmSearch.ShowModal;
end;

procedure TfrmSM_Msg.sgrdStringSetEditText(Sender: TObject; ACol,
  ARow: Integer; const Value: String);
begin
  if sgrdstring.EditorMode then
    sgrdstring_State:=stEdit
   else
    sgrdstring_State:=stInsert;
end;

procedure TfrmSM_Msg.Cur_Send;
var
 s:string;
begin
MobilePhone_List.Clear;
if Trim(sgrdstring.Cells[2,sgrdstring.Row])<>'' then
begin
 s:=Trim(sgrdstring.Cells[2,sgrdstring.Row]);
 MobilePhone_List.Add(s);
end;
if MobilePhone_List.Count=0 then
 ErrorMsg(1,'请选择队列中的手机号码!') else
Send_SM;
end;

procedure TfrmSM_Msg.N8Click(Sender: TObject);
begin
 Cur_Send;
end;

procedure TfrmSM_Msg.N2Click(Sender: TObject);
var
 s:string;
 i:integer;
begin
MobilePhone_List.Clear;
for i:=0 to sgrdstring.RowCount-1 do
 if (Trim(sgrdstring.Cells[2,i+1])<>'')and
  (Trim(sgrdstring.Cells[3,i+1])='√') then
 begin
  s:=Trim(sgrdstring.Cells[2,i+1]);
  MobilePhone_List.Add(s);
 end;
 if MobilePhone_List.Count=0 then
   ErrorMsg(1,'队列中没有手机号码!') else
 Send_SM;
end;

procedure TfrmSM_Msg.sgrdStringGetEditText(Sender: TObject; ACol,
  ARow: Integer; var Value: String);
begin
if sgrdstring_State=stBrowse then
 F_OldMobilePhone:=Value;
end;

procedure TfrmSM_Msg.TmrSendTimer(Sender: TObject);
var
 SearchPhone:string;
begin
d:=FormatDateTime('yyyymmddhhmmss',Now);
SearchPhone:=MobilePhone_List.Strings[0];
Receive_MobilePhone:=ReadSM(Copy(SearchPhone,13,12));
Receive_Name:=SearchPhoneNote(Receive_MobilePhone);
Info_Content:=UnicodeToStr(SendLine.Strings[0]);
if Receive_Name='' then
CurLogMsg(0,'发送'+Receive_MobilePhone+'的信息‖发送时间'+d+'‖信息内容【'+Info_Content+'】')
else
CurLogMsg(0,'发送'+Receive_Name+'的信息‖发送时间'+d+'‖信息内容【'+Info_Content+'】');
Timer1.Interval:=500;
CommSendMsg;
end;

procedure TfrmSM_Msg.sgrdString3DrawCell(Sender: TObject; ACol,
  ARow: Integer; Rect: TRect; State: TGridDrawState);
var
  OldAlign,
  OldBkMode,
  OldTextColor:Integer;
  Text_Height, X, Y:Integer;
begin
  Inherited;
  with sgrdString3.Canvas do
  begin
    if ((ACol=1)or(ACol=2))and(State=[]) then
      Font.Color:=clBlack;
    FillRect(Rect);
    OldBkMode:=SetBkMode(Handle, OPAQUE	);
    OldAlign:=SetTextAlign(Handle, TA_Center);
//    sgrdString3.Canvas.Rectangle(Rect.Left,0,Rect.Right,Rect.Bottom);
    Text_Height:=TextHeight('Test');
    X:=(Rect.Left+Rect.Right) div 2+1;
    Y:=(Rect.Bottom+Rect.Top-Text_Height) div 2;
    if Y<0 then Y:=0;
    OldTextColor:=Font.Color;
    if (ARow=0)or(ACol=0) then
    begin
      Font.Color:=clWhite;
      TextOut(X+1, Y+1, sgrdString3.Cells[ACol, ARow]);
    end;
    Font.Color:=OldTextColor;
    TextOut(X, Y, sgrdString3.Cells[ACol, ARow]);
    SetTextAlign(Handle, OldAlign);
    SetBkMode(Handle, OldBkMode);
  end;
end;

procedure TfrmSM_Msg.TV_ChatRecordChange(Sender: TObject; Node: TTreeNode);
var
 sqlstr,s:string;
 i:integer;
begin
if Node.Level>0 then
 begin
  s:=Trim(TV_ChatRecord.Selected.Text);
  sqlstr:='select * from SM_Message where Receive_MobilePhone like '''+s+'''';
  with frmMsgDB.qryChatMsg do
   begin
    Close;
    SQL.Clear;
    SQL.Add(sqlstr);
    Open;
   end;
  if frmMsgDB.qryChatMsg.RecordCount>0 then
  begin
   sgrdString3.RowCount:=2;
   mem_Chat.Clear;
   frmMsgDB.qryChatMsg.First;
   while not frmMsgDB.qryChatMsg.Eof do
    with sgrdString3 do
     begin
      RowCount:=RowCount+1;
       with frmMsgDB.qryChatMsg do
        begin
         Cells[0,RowCount-2]:= Fields[0].Text;
         Cells[1,RowCount-2]:= Fields[1].Text;
         Cells[2,RowCount-2]:= Fields[2].Text;
         Cells[3,RowCount-2]:= Fields[3].Text;
         Cells[4,RowCount-2]:= Fields[5].Text;
         Next;
        end;
     end;
     if sgrdString3.RowCount>2 then
     sgrdString3.RowCount:=sgrdString3.RowCount-1;
     sgrdString3.Row:=1;
   end  else
    begin
     mem_Chat.Clear;
     for i:=0 to sgrdString3.ColCount-1 do
          sgrdstring3.Cells[i,1]:='';
    end;
  end  else
  if Node.Level=0 then
   begin
    sgrdString3.RowCount:=2;
    mem_Chat.Clear;
    for i:=0 to sgrdstring3.ColCount-1 do
    sgrdstring3.Cells[i,1]:='';
   end;
end;

procedure TfrmSM_Msg.sgrdString3SelectCell(Sender: TObject; ACol,
  ARow: Integer; var CanSelect: Boolean);
var
 a,s:string;
begin
a:='';s:='';
a:=sgrdstring3.Cells[1,ARow];
s:=sgrdstring3.Cells[3,ARow];
mem_Chat.Clear;
with frmMsgDB.qryChatMsgSub do
 begin
  Close;
  Parameters.ParamByName('FMobilePhone').Value:=a;
  Parameters.ParamByName('FOccur_Date').Value:=s;
  Open;
 end;
if frmMsgDB.qryChatMsgSub.RecordCount>0 then
if frmMsgDB.qryChatMsgSub.Fields[6].Text='Send' then
 mem_Chat.Lines.Add('发送的信息:【'+frmMsgDB.qryChatMsgSub.Fields[4].text+'】')
  else
 mem_Chat.Lines.Add('收到的信息:【'+frmMsgDB.qryChatMsgSub.Fields[4].text+'】');
end;

procedure TfrmSM_Msg.BitBtn8Click(Sender: TObject);
begin
sgrdstring1.Cells[1,sgrdstring1.Row]:='';
Refresh_sgrd(1);
end;

procedure TfrmSM_Msg.BitBtn7Click(Sender: TObject);
var
 i:integer;
 Context:TStringList;
begin
Context:=TStringList.Create;
for i:=0 to sgrdstring1.RowCount-1 do
 if sgrdstring1.Cells[1,i+1]<>'' then
 Context.Add(sgrdstring1.Cells[1,i+1]);
WriteDy(Context);
Context.Free;
end;

procedure TfrmSM_Msg.BitBtn6Click(Sender: TObject);
begin
sgrdString1.RowCount:=sgrdString1.RowCount+1;
sgrdString1.Row:=sgrdString1.RowCount-1;
sgrdString1.EditorMode:=True;
end;

procedure TfrmSM_Msg.bit_DelChatMsgClick(Sender: TObject);
const
 strsql = 'select * from SM_Message where Receive_MobilePhone=';
var
 MobilePhone,Occur_Date:string;
 i:integer;
begin
if Chat_RootNode.Level>0 then
if Application.MessageBox('是否删除此记录?','确认',
       MB_IconQuestion+MB_YesNo)=IDYes then
begin
MobilePhone:=sgrdstring3.Cells[1,sgrdString3.Row];
Occur_Date:=sgrdstring3.Cells[3,sgrdString3.Row];
for i:=0 to sgrdstring3.ColCount-1 do
sgrdString3.Rows[sgrdstring3.Row].Clear;
Refresh_sgrd(3);
 with frmMsgDB.delChatMsg do
  begin
   Close;
   Parameters.ParamByName('FMobilePhone').Value:=MobilePhone;
   Parameters.ParamByName('FOccur_Date').Value:=Occur_Date;
   ExecSQL;
  end;
 with frmMsgDB.qryChatMsg do
 begin
  Close;
  SQL.Clear;
  SQL.Add(strsql+''''+MobilePhone+'''');
  ExecSQL;
  Open;
 end;
 if frmMsgDB.qryChatMsg.RecordCount<1 then
 begin
  with frmMsgDB.delChatNum do
   begin
    Close;
    Parameters.ParamByName('FMobilePhone').Value:=MobilePhone;
    ExecSQL;
   end;
   TV_ChatRecord.Selected.Delete;
  end;
 end;
 frmMsgDB.qryChatMsg.Close;
 frmMsgDB.delChatNum.Close;
end;

procedure TfrmSM_Msg.BitBtn11Click(Sender: TObject);
begin
ChatRecord;

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -