Vivarium

В этом зоопарке собран код, присылаемый нам читателями рассылки.
Вам есть чем поделиться? Милости просим на Этот адрес e-mail защищен от спам-ботов. Чтобы увидеть его, у Вас должен быть включен Java-Script

Функция, возвращающая подстроку между разделителями из строки – аналог SELECTSTR, но более фунциональный (прислал Кирилл Чернецкий):

PROCEDURE GetSubstringByIndex(pInString : Text[1024];pIndex : Integer; pDelimiter: Text[3]) fOutString : Text[1024]
BEGIN
  fOutString := '';

  IF pDelimiter = '' THEN 
    pDelimiter := ';'; 
  IF pIndex <= 0 THEN 
    pIndex := 1; 

  WordEnd := 1; 
  WordStart := 1; 
  CurrentIndex := 0; 
  DelimCount := 0; 

  REPEAT
    CurrentIndex += 1;
    IF FORMAT(pInString[CurrentIndex]) = pDelimiter THEN BEGIN
      WordStart := WordEnd;
      WordEnd := CurrentIndex;
      DelimCount += 1;
    END;
  UNTIL (CurrentIndex = STRLEN(pInString)) OR (DelimCount = pIndex);

  IF (CurrentIndex = STRLEN(pInString)) AND (WordEnd <> CurrentIndex) THEN BEGIN
    WordStart := WordEnd;
    WordEnd := CurrentIndex + 1;
  END;

  IF DelimCount > 0 THEN BEGIN
    IF WordStart = 1 THEN
      fOutString := COPYSTR(pInString,WordStart,WordEnd - WordStart)
    ELSE
      fOutString := COPYSTR(pInString,WordStart + 1,WordEnd - WordStart - 1); 
  END ELSE BEGIN
    fOutString := pInString;
  END;
  EXIT(fOutString);
END;

Проверка доступности директории в C/SIDE (прислал Кирилл Чернецкий):

PROCUDURE FolderExists(pFolderPath : Text[250]) vResult : Boolean
VAR
locFN : Text[250];
locF : File;

BEGIN
  vResult := FALSE;
  IF COPYSTR(pFolderPath,STRLEN(pFolderPath),1) <> '\' THEN
    pFolderPath := pFolderPath + '\'; 
  locFN := FORMAT(CREATEGUID) + '.test'; 
  CLEAR(locF); 
  locF.TEXTMODE(TRUE); 
  locF.WRITEMODE(TRUE); 
  IF locF.CREATE(pFolderPath + locFN) THEN BEGIN
    locF.CLOSE; 
    IF EXISTS(pFolderPath + locFN) THEN 
      ERASE(pFolderPath + locFN); 
    vResult := TRUE; 
  END; 
  EXIT(vResult);
END;

Функция-аналог REPLACE() в MS SQL:

PROCEDURE SqlReplace(ptxtOriginal : Text[1024];ptxtFrom : Text[1024];ptxtTo : Text[1024]) : Text[1024];
VAR
  txtResult : Text[1024];
  i : Integer;
BEGIN
  // аналог MS SQL REPLACE
  REPEAT
    i := STRPOS(ptxtOriginal, ptxtFrom);

    IF i > 0 THEN BEGIN

      IF i = 1 THEN
        txtResult += ptxtTo
      ELSE
        txtResult += COPYSTR(ptxtOriginal, 1, i-1) + ptxtTo;

      IF i < STRLEN(ptxtOriginal) THEN
        ptxtOriginal := COPYSTR(ptxtOriginal, i+STRLEN(ptxtFrom), 
                                STRLEN(ptxtOriginal) + 1 - (i + STRLEN(ptxtFrom)))
      ELSE
        ptxtOriginal := '';

    END ELSE
      txtResult += ptxtOriginal;

  UNTIL i = 0;

  EXIT(txtResult);

END;

Функция, которая возвращает разделитель целой и дробной части числа.

PROCEDURE GetDecimalSign() : Text[1];
BEGIN
  EXIT(COPYSTR(FORMAT(1.5),2,1));
END;

Функция преобразования текста в число. Одним словом, улучшенный аналог EVALUATE(). Преобразование не зависит от региональных настроек.

PROCEDURE GetNumber(txtNumber : Text[100]) : Decimal;
VAR
  txtTempNumber : Text[100];
  intPos : Integer;
  decResult : Decimal;

BEGIN
  // Выделяем число. Если число формата 1,000.00 , то надо сделать 1000,00
  // Т.е. надо убрать все запятые, а точку превратить в запятую
  txtTempNumber := txtNumber;

  // Убираем пробелы
  WHILE (STRPOS(txtTempNumber, ' ') <> 0) DO BEGIN
    intPos := STRPOS(txtTempNumber, ' ');
    txtTempNumber := COPYSTR(txtTempNumber, 1, intPos-1) + COPYSTR(txtTempNumber, intPos+1);
  END;

  IF EVALUATE(decResult, txtTempNumber) THEN
    EXIT(decResult);

  // Убираем запятые
  WHILE (STRPOS(txtTempNumber, ',') <> 0) DO BEGIN
    intPos := STRPOS(txtTempNumber,',');
    txtTempNumber := COPYSTR(txtTempNumber, 1, intPos-1) + COPYSTR(txtTempNumber, intPos+1);
  END;

  // Меняем точку на запятую
  intPos := STRPOS(txtTempNumber, '.');
  IF intPos <> 0 THEN
    txtTempNumber := COPYSTR(txtTempNumber, 1, intPos-1) + ',' + COPYSTR(txtTempNumber, intPos+1);

  IF EVALUATE(decResult, txtTempNumber) THEN
    EXIT(decResult)
  ELSE
    EXIT(0);
END;	

Функция получения имени временного файла из GUID (а сам файл будет во временной папке %TEMP%). Вам остается только добавить к нему нужное расширение.

PROCEDURE GetTempFileName() : Text[250];
BEGIN
  //Возвращает имя временого файла в директории TEMP (без расширения!)
  EXIT(ENVIRON('TEMP') + '\' + COPYSTR(FORMAT(CREATEGUID), 2, STRLEN(FORMAT(CREATEGUID))-2));	
END;  

Заметили ошибку? Можете предложить новый вариант? ЗНАЕТЕ, КАК ЛУЧШЕ? Срочно сюда – Этот адрес e-mail защищен от спам-ботов. Чтобы увидеть его, у Вас должен быть включен Java-Script  :-)