ftpsend.pas

snmp设计增加相应SNMP的OID,是实时处理的.

          begin
            if Value[Ivalue] = ' ' then
              break;
            Inc(Ivalue);
          end;
          while IValue <= Length(Value) do
          begin
            if Value[Ivalue] <> ' ' then
              break;
            Inc(Ivalue);
          end;
          Dec(IValue);
        end;
      '$':
        begin
          while IValue <= Length(Value) do
          begin
            if not(Value[Ivalue] in [' ', #9]) then
              break;
            Inc(Ivalue);
          end;
          Dec(IValue);
        end;
      '=':
        begin
          s := '';
          case LastmaskC of
            'S':
              begin
                while Imask <= Length(Mask) do
                begin
                  if not(Mask[Imask] in ['0'..'9']) then
                    break;
                  s := s + Mask[Imask];
                  Inc(Imask);
                end;
                Dec(Imask);
                BlockSize := s;
              end;
            'T':
              begin
                Monthnames := Copy(Mask, IMask, 12 * 3);
                Inc(IMask, 12 * 3);
              end;
            'd':
              begin
                Inc(Imask);
                DirFlagValue := Mask[Imask];
              end;
          end;
        end;
      '\':
        begin
          Value := NextValue;
          IValue := 0;
          Result := 2;
        end;
    end;
    Inc(Ivalue);
    Inc(Imask);
    LastMaskC := MaskC;
  end;
end;

function TFTPList.CheckValues: Boolean;
var
  x, n: integer;
begin
  Result := false;
  if FileName <> '' then
  begin
    if pos('?', VMSFilename) > 0 then
      Exit;
    if pos('*', VMSFilename) > 0 then
      Exit;
  end;
  if VMSFileName <> '' then
    if pos(';', VMSFilename) <= 0 then
      Exit;
  if (FileName = '') and (VMSFileName = '') then
    Exit;
  if Permissions <> '' then
  begin
    if length(Permissions) <> 10 then
      Exit;
    for n := 1 to 10 do
      if not(Permissions[n] in
        ['a', 'b', 'c', 'd', 'h', 'l', 'p', 'r', 's', 'w', 'x', 'y', '-']) then
        Exit;
  end;
  if Day <> '' then
  begin
    Day := TrimSP(Day);
    x := StrToIntDef(day, -1);
    if (x < 1) or (x > 31) then
      Exit;
  end;
  if Month <> '' then
  begin
    Month := TrimSP(Month);
    x := StrToIntDef(Month, -1);
    if (x < 1) or (x > 12) then
      Exit;
  end;
  if Hours <> '' then
  begin
    Hours := TrimSP(Hours);
    x := StrToIntDef(Hours, -1);
    if (x < 0) or (x > 24) then
      Exit;
  end;
  if HoursModif <> '' then
  begin
    if not (HoursModif[1] in ['a', 'A', 'p', 'P']) then
      Exit;
  end;
  if Minutes <> '' then
  begin
    Minutes := TrimSP(Minutes);
    x := StrToIntDef(Minutes, -1);
    if (x < 0) or (x > 59) then
      Exit;
  end;
  if Seconds <> '' then
  begin
    Seconds := TrimSP(Seconds);
    x := StrToIntDef(Seconds, -1);
    if (x < 0) or (x > 59) then
      Exit;
  end;
  if Size <> '' then
  begin
    Size := TrimSP(Size);
    for n := 1 to Length(Size) do
      if not (Size[n] in ['0'..'9']) then
        Exit;
  end;

  if length(Monthnames) = (12 * 3) then
    for n := 1 to 12 do
      CustomMonthNames[n] := Copy(Monthnames, ((n - 1) * 3) + 1, 3);
  if ThreeMonth <> '' then
  begin
    x := GetMonthNumber(ThreeMonth);
    if (x = 0) then
      Exit;
  end;
  if YearTime <> '' then
  begin
    YearTime := ReplaceString(YearTime, '-', ':');
    if pos(':', YearTime) > 0 then
    begin
      if (GetTimeFromstr(YearTime) = -1) then
        Exit;
    end
    else
    begin
      YearTime := TrimSP(YearTime);
      x := StrToIntDef(YearTime, -1);
      if (x = -1) then
        Exit;
      if (x < 1900) or (x > 2100) then
        Exit;
    end;
  end;
  if Year <> '' then
  begin
    Year := TrimSP(Year);
    x := StrToIntDef(Year, -1);
    if (x = -1) then
      Exit;
    if Length(Year) = 4 then
    begin
      if not((x > 1900) and (x < 2100)) then
        Exit;
    end
    else
      if Length(Year) = 2 then
      begin
        if not((x >= 0) and (x <= 99)) then
          Exit;
      end
      else
        if Length(Year) = 3 then
        begin
          if not((x >= 100) and (x <= 110)) then
            Exit;
        end
        else
          Exit;
  end;
  Result := True;
end;

procedure TFTPList.FillRecord(const Value: TFTPListRec);
var
  s: string;
  x: integer;
  myear: Word;
  mmonth: Word;
  mday: Word;
  mhours, mminutes, mseconds: word;
  n: integer;
begin
  s := DirFlagValue;
  if s = '' then
    s := 'D';
  s := Uppercase(s);
  Value.Directory :=  s = Uppercase(DirFlag);
  if FileName <> '' then
    Value.FileName := SeparateLeft(Filename, ' -> ');
  if VMSFileName <> '' then
  begin
    Value.FileName := VMSFilename;
    Value.Directory := Pos('.DIR;',VMSFilename) > 0;
  end;
  Value.FileName := TrimSPRight(Value.FileName);
  Value.Readable := not Value.Directory;
  if BlockSize <> '' then
    x := StrToIntDef(BlockSize, 1)
  else
    x := 1;
  Value.FileSize := x * StrToIntDef(Size, 0);

  DecodeDate(Date,myear,mmonth,mday);
  mhours := 0;
  mminutes := 0;
  mseconds := 0;

  if Day <> '' then
    mday := StrToIntDef(day, 1);
  if Month <> '' then
    mmonth := StrToIntDef(Month, 1);
  if length(Monthnames) = (12 * 3) then
    for n := 1 to 12 do
      CustomMonthNames[n] := Copy(Monthnames, ((n - 1) * 3) + 1, 3);
  if ThreeMonth <> '' then
    mmonth := GetMonthNumber(ThreeMonth);
  if Year <> '' then
  begin
    myear := StrToIntDef(Year, 0);
    if (myear <= 99) and (myear > 50) then
      myear := myear + 1900;
    if myear <= 50 then
      myear := myear + 2000;
  end;
  if YearTime <> '' then
  begin
    if pos(':', YearTime) > 0 then
    begin
      YearTime := TrimSP(YearTime);
      mhours := StrToIntDef(Separateleft(YearTime, ':'), 0);
      mminutes := StrToIntDef(SeparateRight(YearTime, ':'), 0);
      if (Encodedate(myear, mmonth, mday)
        + EncodeTime(mHours, mminutes, 0, 0)) > now then
        Dec(mYear);
    end
    else
      myear := StrToIntDef(YearTime, 0);
  end;
  if Minutes <> '' then
    mminutes := StrToIntDef(Minutes, 0);
  if Seconds <> '' then
    mseconds := StrToIntDef(Seconds, 0);
  if Hours <> '' then
  begin
    mHours := StrToIntDef(Hours, 0);
    if HoursModif <> '' then
      if Uppercase(HoursModif[1]) = 'P' then
        if mHours <> 12 then
          mHours := MHours + 12;
  end;
  Value.FileTime := Encodedate(myear, mmonth, mday)
    + EncodeTime(mHours, mminutes, mseconds, 0);
  if Permissions <> '' then
  begin
    Value.Permission := Permissions;
    Value.Readable := Uppercase(permissions)[2] = 'R';
    if Uppercase(permissions)[1] = 'D' then
    begin
      Value.Directory := True;
      Value.Readable := false;
    end
    else
      if Uppercase(permissions)[1] = 'L' then
        Value.Directory := True;
  end;
end;

function TFTPList.ParseEPLF(Value: string): Boolean;
var
  s, os: string;
  flr: TFTPListRec;
begin
  Result := False;
  if Value <> '' then
    if Value[1] = '+' then
    begin
      os := Value;
      flr := TFTPListRec.create;
      s := Fetch(Value, ',');
      while s <> '' do
      begin
        if s[1] = #9 then
        begin
          flr.FileName := Copy(s, 2, Length(s) - 1);
        end;
        case s[1] of
          '/':
            flr.Directory := true;
          'r':
            flr.Readable := true;
          's':
            flr.FileSize := StrToIntDef(Copy(s, 2, Length(s) - 1), 0);
          'm':
            flr.FileTime := (StrToIntDef(Copy(s, 2, Length(s) - 1), 0) / 86400)
              + 25569;
        end;
        s := Fetch(Value, ',');
      end;
      if flr.FileName <> '' then
      if (flr.Directory and ((flr.FileName = '.') or (flr.FileName = '..')))
        or (flr.FileName = '') then
        flr.free
      else
      begin
        flr.OriginalLine := os;
        flr.Mask := 'EPLF';
        Flist.Add(flr);
        Result := True;
      end;
    end;
end;

procedure TFTPList.ParseLines;
var
  flr: TFTPListRec;
  n, m: Integer;
  S: string;
  x: integer;
  b: Boolean;
begin
  n := 0;
  while n < Lines.Count do
  begin
    if n = Lines.Count - 1 then
      s := ''
    else
      s := Lines[n + 1];
    b := False;
    x := 0;
    if ParseEPLF(Lines[n]) then
    begin
      b := True;
      x := 1;
    end
    else
      for m := 0 to Masks.Count - 1 do
      begin
        x := ParseByMask(Lines[n], s, Masks[m]);
        if x > 0 then
          if CheckValues then
          begin
            flr := TFTPListRec.create;
            FillRecord(flr);
            flr.OriginalLine := Lines[n];
            flr.Mask := Masks[m];
            if flr.Directory and ((flr.FileName = '.') or (flr.FileName = '..')) then
              flr.free
            else
              Flist.Add(flr);
            b := True;
            Break;
          end;
      end;
    if not b then
      FUnparsedLines.Add(Lines[n]);
    Inc(n);
    if x > 1 then
      Inc(n, x - 1);
  end;
end;

{==============================================================================}

function FtpGetFile(const IP, Port, FileName, LocalFile,
  User, Pass: string): Boolean;
begin
  Result := False;
  with TFTPSend.Create do
  try
    if User <> '' then
    begin
      Username := User;
      Password := Pass;
    end;
    TargetHost := IP;
    TargetPort := Port;
    if not Login then
      Exit;
    DirectFileName := LocalFile;
    DirectFile:=True;
    Result := RetrieveFile(FileName, False);
    Logout;
  finally
    Free;
  end;
end;

function FtpPutFile(const IP, Port, FileName, LocalFile,
  User, Pass: string): Boolean;
begin
  Result := False;
  with TFTPSend.Create do
  try
    if User <> '' then
    begin
      Username := User;
      Password := Pass;
    end;
    TargetHost := IP;
    TargetPort := Port;
    if not Login then
      Exit;
    DirectFileName := LocalFile;
    DirectFile:=True;
    Result := StoreFile(FileName, False);
    Logout;
  finally
    Free;
  end;
end;

function FtpInterServerTransfer(
  const FromIP, FromPort, FromFile, FromUser, FromPass: string;
  const ToIP, ToPort, ToFile, ToUser, ToPass: string): Boolean;
var
  FromFTP, ToFTP: TFTPSend;
  s: string;
  x: integer;
begin
  Result := False;
  FromFTP := TFTPSend.Create;
  toFTP := TFTPSend.Create;
  try
    if FromUser <> '' then
    begin
      FromFTP.Username := FromUser;
      FromFTP.Password := FromPass;
    end;
    if ToUser <> '' then
    begin
      ToFTP.Username := ToUser;
      ToFTP.Password := ToPass;
    end;
    FromFTP.TargetHost := FromIP;
    FromFTP.TargetPort := FromPort;
    ToFTP.TargetHost := ToIP;
    ToFTP.TargetPort := ToPort;
    if not FromFTP.Login then
      Exit;
    if not ToFTP.Login then
      Exit;
    if (FromFTP.FTPCommand('PASV') div 100) <> 2 then
      Exit;
    FromFTP.ParseRemote(FromFTP.ResultString);
    s := ReplaceString(FromFTP.DataIP, '.', ',');
    s := 'PORT ' + s + ',' + IntToStr(StrToIntDef(FromFTP.DataPort, 0) div 256)
      + ',' + IntToStr(StrToIntDef(FromFTP.DataPort, 0) mod 256);
    if (ToFTP.FTPCommand(s) div 100) <> 2 then
      Exit;
    x := ToFTP.FTPCommand('RETR ' + FromFile);
    if (x div 100) <> 1 then
      Exit;
    x := FromFTP.FTPCommand('STOR ' + ToFile);
    if (x div 100) <> 1 then
      Exit;
    FromFTP.Timeout := 21600000;
    x := FromFTP.ReadResult;
    if (x  div 100) <> 2 then
      Exit;
    ToFTP.Timeout := 21600000;
    x := ToFTP.ReadResult;
    if (x div 100) <> 2 then
      Exit;
    Result := True;
  finally
    ToFTP.Free;
    FromFTP.Free;
  end;
end;

end.